KIDS Distribution saved on Jun 06, 2019@13:09:27 PRCA*4.5*332, IB*2.0*633 **KIDS**:PRCA IB EPAYMENTS BUNDLE 4.0^PRCA*4.5*332^IB*2.0*633^ **INSTALL NAME** PRCA IB EPAYMENTS BUNDLE 4.0 "BLD",11069,0) PRCA IB EPAYMENTS BUNDLE 4.0^^1^3190606^y "BLD",11069,1,0) ^^1^1^3190509^ "BLD",11069,1,1,0) MCCF EDI TAS EPAYMENTS BUILD 7/8 "BLD",11069,6.3) 22 "BLD",11069,10,0) ^9.63^2^2 "BLD",11069,10,1,0) PRCA*4.5*332^1 "BLD",11069,10,2,0) IB*2.0*633 "BLD",11069,10,"B","IB*2.0*633",2) "BLD",11069,10,"B","PRCA*4.5*332",1) "BLD",11069,"KRN",0) ^9.67PA^779.2^20 "BLD",11069,"KRN",.4,0) .4 "BLD",11069,"KRN",.401,0) .401 "BLD",11069,"KRN",.402,0) .402 "BLD",11069,"KRN",.403,0) .403 "BLD",11069,"KRN",.5,0) .5 "BLD",11069,"KRN",.84,0) .84 "BLD",11069,"KRN",3.6,0) 3.6 "BLD",11069,"KRN",3.8,0) 3.8 "BLD",11069,"KRN",9.2,0) 9.2 "BLD",11069,"KRN",9.8,0) 9.8 "BLD",11069,"KRN",19,0) 19 "BLD",11069,"KRN",19.1,0) 19.1 "BLD",11069,"KRN",101,0) 101 "BLD",11069,"KRN",409.61,0) 409.61 "BLD",11069,"KRN",771,0) 771 "BLD",11069,"KRN",779.2,0) 779.2 "BLD",11069,"KRN",870,0) 870 "BLD",11069,"KRN",8989.51,0) 8989.51 "BLD",11069,"KRN",8989.52,0) 8989.52 "BLD",11069,"KRN",8994,0) 8994 "BLD",11069,"KRN","B",.4,.4) "BLD",11069,"KRN","B",.401,.401) "BLD",11069,"KRN","B",.402,.402) "BLD",11069,"KRN","B",.403,.403) "BLD",11069,"KRN","B",.5,.5) "BLD",11069,"KRN","B",.84,.84) "BLD",11069,"KRN","B",3.6,3.6) "BLD",11069,"KRN","B",3.8,3.8) "BLD",11069,"KRN","B",9.2,9.2) "BLD",11069,"KRN","B",9.8,9.8) "BLD",11069,"KRN","B",19,19) "BLD",11069,"KRN","B",19.1,19.1) "BLD",11069,"KRN","B",101,101) "BLD",11069,"KRN","B",409.61,409.61) "BLD",11069,"KRN","B",771,771) "BLD",11069,"KRN","B",779.2,779.2) "BLD",11069,"KRN","B",870,870) "BLD",11069,"KRN","B",8989.51,8989.51) "BLD",11069,"KRN","B",8989.52,8989.52) "BLD",11069,"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.2 **INSTALL NAME** PRCA*4.5*332 "BLD",11006,0) PRCA*4.5*332^ACCOUNTS RECEIVABLE^0^3190606^y "BLD",11006,1,0) ^^1^1^3180726^^ "BLD",11006,1,1,0) MCCF EDI TAS EPAYMENTS BUILD 3 "BLD",11006,4,0) ^9.64PA^342^3 "BLD",11006,4,342,0) 342 "BLD",11006,4,342,2,0) ^9.641^342^1 "BLD",11006,4,342,2,342,0) AR SITE PARAMETER (File-top level) "BLD",11006,4,342,2,342,1,0) ^9.6411^7.09^1 "BLD",11006,4,342,2,342,1,7.09,0) AUTO-AUDIT TRICARE EDI BILLS "BLD",11006,4,342,222) y^y^p^^^^n^^n "BLD",11006,4,342,224) "BLD",11006,4,344.5,0) 344.5 "BLD",11006,4,344.5,2,0) ^9.641^344.5^1 "BLD",11006,4,344.5,2,344.5,0) AR EDI LOCKBOX MESSAGES (File-top level) "BLD",11006,4,344.5,2,344.5,1,0) ^9.6411^.15^1 "BLD",11006,4,344.5,2,344.5,1,.15,0) DUPLICATE INDICATOR "BLD",11006,4,344.5,222) y^y^p^^^^n^^n "BLD",11006,4,344.5,224) "BLD",11006,4,344.61,0) 344.61 "BLD",11006,4,344.61,2,0) ^9.641^344.61^2 "BLD",11006,4,344.61,2,344.61,0) RCDPE PARAMETER (File-top level) "BLD",11006,4,344.61,2,344.61,1,0) ^9.6411^.07^5 "BLD",11006,4,344.61,2,344.61,1,.07,0) PHARMACY EFT POST PREVENT DAYS "BLD",11006,4,344.61,2,344.61,1,.13,0) TRICARE EFT POST PREVENT DAYS "BLD",11006,4,344.61,2,344.61,1,26,0) TRICARE EFT OVERRIDE "BLD",11006,4,344.61,2,344.61,1,27,0) USER - TRICARE OVERRIDE "BLD",11006,4,344.61,2,344.61,1,28,0) COMMENT - TRICARE OVERRIDE "BLD",11006,4,344.61,2,344.611,0) HISTORY (sub-file) "BLD",11006,4,344.61,2,344.611,1,0) ^9.6411^4^6 "BLD",11006,4,344.61,2,344.611,1,.01,0) DATE "BLD",11006,4,344.61,2,344.611,1,.02,0) USER "BLD",11006,4,344.61,2,344.611,1,1,0) PARAMETER "BLD",11006,4,344.61,2,344.611,1,2,0) DETAIL "BLD",11006,4,344.61,2,344.611,1,3,0) OLD VALUE "BLD",11006,4,344.61,2,344.611,1,4,0) NEW VALUE "BLD",11006,4,344.61,222) y^n^p^^^^n^^n "BLD",11006,4,344.61,224) "BLD",11006,4,"APDD",342,342) "BLD",11006,4,"APDD",342,342,7.09) "BLD",11006,4,"APDD",344.5,344.5) "BLD",11006,4,"APDD",344.5,344.5,.15) "BLD",11006,4,"APDD",344.61,344.61) "BLD",11006,4,"APDD",344.61,344.61,.07) "BLD",11006,4,"APDD",344.61,344.61,.13) "BLD",11006,4,"APDD",344.61,344.61,26) "BLD",11006,4,"APDD",344.61,344.61,27) "BLD",11006,4,"APDD",344.61,344.61,28) "BLD",11006,4,"APDD",344.61,344.611) "BLD",11006,4,"APDD",344.61,344.611,.01) "BLD",11006,4,"APDD",344.61,344.611,.02) "BLD",11006,4,"APDD",344.61,344.611,1) "BLD",11006,4,"APDD",344.61,344.611,2) "BLD",11006,4,"APDD",344.61,344.611,3) "BLD",11006,4,"APDD",344.61,344.611,4) "BLD",11006,4,"B",342,342) "BLD",11006,4,"B",344.5,344.5) "BLD",11006,4,"B",344.61,344.61) "BLD",11006,6.3) 40 "BLD",11006,"ABPKG") n "BLD",11006,"INIT") POST^RCP332 "BLD",11006,"KRN",0) ^9.67PA^779.2^20 "BLD",11006,"KRN",.4,0) .4 "BLD",11006,"KRN",.4,"NM",0) ^9.68A^^ "BLD",11006,"KRN",.401,0) .401 "BLD",11006,"KRN",.402,0) .402 "BLD",11006,"KRN",.402,"NM",0) ^9.68A^^ "BLD",11006,"KRN",.403,0) .403 "BLD",11006,"KRN",.5,0) .5 "BLD",11006,"KRN",.84,0) .84 "BLD",11006,"KRN",3.6,0) 3.6 "BLD",11006,"KRN",3.8,0) 3.8 "BLD",11006,"KRN",9.2,0) 9.2 "BLD",11006,"KRN",9.8,0) 9.8 "BLD",11006,"KRN",9.8,"NM",0) ^9.68A^48^47 "BLD",11006,"KRN",9.8,"NM",1,0) RCDPEMAP^^0^B105695606 "BLD",11006,"KRN",9.8,"NM",2,0) RCDPEMA1^^0^B72907594 "BLD",11006,"KRN",9.8,"NM",3,0) RCDPEFTL^^0^B84961666 "BLD",11006,"KRN",9.8,"NM",4,0) RCDPESR2^^0^B93198829 "BLD",11006,"KRN",9.8,"NM",5,0) RCDPEX5^^0^B66895490 "BLD",11006,"KRN",9.8,"NM",6,0) RCDPESR6^^0^B60062437 "BLD",11006,"KRN",9.8,"NM",7,0) RCDPEX1^^0^B23011676 "BLD",11006,"KRN",9.8,"NM",8,0) RCDPESP6^^0^B65240726 "BLD",11006,"KRN",9.8,"NM",9,0) RCDPEP^^0^B154349379 "BLD",11006,"KRN",9.8,"NM",10,0) RCDPESP8^^0^B22209300 "BLD",11006,"KRN",9.8,"NM",11,0) RCDPRLIS^^0^B143635402 "BLD",11006,"KRN",9.8,"NM",12,0) RCDPEAC^^0^B169995417 "BLD",11006,"KRN",9.8,"NM",13,0) RCDPENR3^^0^B210652613 "BLD",11006,"KRN",9.8,"NM",14,0) RCDPEARL^^0^B41725584 "BLD",11006,"KRN",9.8,"NM",15,0) RCDPRSEA^^0^B85725448 "BLD",11006,"KRN",9.8,"NM",16,0) RCDPEM2^^0^B146585710 "BLD",11006,"KRN",9.8,"NM",17,0) RCDPEU1^^0^B121893428 "BLD",11006,"KRN",9.8,"NM",18,0) RCDPEWL7^^0^B240834871 "BLD",11006,"KRN",9.8,"NM",19,0) RCDPEE^^0^B114741630 "BLD",11006,"KRN",9.8,"NM",20,0) RCDPESP^^0^B142229287 "BLD",11006,"KRN",9.8,"NM",21,0) RCDPESP1^^0^B113871339 "BLD",11006,"KRN",9.8,"NM",22,0) RCDPEUPO^^0^B47349551 "BLD",11006,"KRN",9.8,"NM",23,0) RCDPEWLP^^0^B201114317 "BLD",11006,"KRN",9.8,"NM",24,0) RCDPESPA^^0^B72015265 "BLD",11006,"KRN",9.8,"NM",26,0) RCDPESP2^^0^B101041466 "BLD",11006,"KRN",9.8,"NM",27,0) RCDPESP5^^0^B268946794 "BLD",11006,"KRN",9.8,"NM",28,0) RCBEUTRA^^0^B30998596 "BLD",11006,"KRN",9.8,"NM",29,0) RCBEADJ1^^0^B18586021 "BLD",11006,"KRN",9.8,"NM",30,0) RCDPEM9^^0^B81919705 "BLD",11006,"KRN",9.8,"NM",31,0) RCDPEWLZ^^0^B23906831 "BLD",11006,"KRN",9.8,"NM",32,0) RCDPRPL4^^0^B36707329 "BLD",11006,"KRN",9.8,"NM",33,0) RCDPRPLM^^0^B101101074 "BLD",11006,"KRN",9.8,"NM",34,0) RCDPEM5^^0^B169813342 "BLD",11006,"KRN",9.8,"NM",35,0) RCDPEU2^^0^B44759277 "BLD",11006,"KRN",9.8,"NM",36,0) RCDPLPL3^^0^B61808211 "BLD",11006,"KRN",9.8,"NM",37,0) RCDPLPL4^^0^B248709221 "BLD",11006,"KRN",9.8,"NM",38,0) RCDPRPL2^^0^B57949754 "BLD",11006,"KRN",9.8,"NM",39,0) PRCABJ2^^0^B20492059 "BLD",11006,"KRN",9.8,"NM",40,0) PRCAEXM^^0^B15458126 "BLD",11006,"KRN",9.8,"NM",41,0) RCDPEM4^^0^B215421276 "BLD",11006,"KRN",9.8,"NM",42,0) RCDPEWL0^^0^B222344847 "BLD",11006,"KRN",9.8,"NM",43,0) RCDPEAA3^^0^B141250003 "BLD",11006,"KRN",9.8,"NM",44,0) RCDPAYER^^0^B25767365 "BLD",11006,"KRN",9.8,"NM",45,0) RCDPEAA2^^0^B160927525 "BLD",11006,"KRN",9.8,"NM",46,0) RCDPEAD^^0^B232051747 "BLD",11006,"KRN",9.8,"NM",47,0) RCDPEX^^0^B80574890 "BLD",11006,"KRN",9.8,"NM",48,0) RCDPEWLD^^0^B136795643 "BLD",11006,"KRN",9.8,"NM","B","PRCABJ2",39) "BLD",11006,"KRN",9.8,"NM","B","PRCAEXM",40) "BLD",11006,"KRN",9.8,"NM","B","RCBEADJ1",29) "BLD",11006,"KRN",9.8,"NM","B","RCBEUTRA",28) "BLD",11006,"KRN",9.8,"NM","B","RCDPAYER",44) "BLD",11006,"KRN",9.8,"NM","B","RCDPEAA2",45) "BLD",11006,"KRN",9.8,"NM","B","RCDPEAA3",43) "BLD",11006,"KRN",9.8,"NM","B","RCDPEAC",12) "BLD",11006,"KRN",9.8,"NM","B","RCDPEAD",46) "BLD",11006,"KRN",9.8,"NM","B","RCDPEARL",14) "BLD",11006,"KRN",9.8,"NM","B","RCDPEE",19) "BLD",11006,"KRN",9.8,"NM","B","RCDPEFTL",3) "BLD",11006,"KRN",9.8,"NM","B","RCDPEM2",16) "BLD",11006,"KRN",9.8,"NM","B","RCDPEM4",41) "BLD",11006,"KRN",9.8,"NM","B","RCDPEM5",34) "BLD",11006,"KRN",9.8,"NM","B","RCDPEM9",30) "BLD",11006,"KRN",9.8,"NM","B","RCDPEMA1",2) "BLD",11006,"KRN",9.8,"NM","B","RCDPEMAP",1) "BLD",11006,"KRN",9.8,"NM","B","RCDPENR3",13) "BLD",11006,"KRN",9.8,"NM","B","RCDPEP",9) "BLD",11006,"KRN",9.8,"NM","B","RCDPESP",20) "BLD",11006,"KRN",9.8,"NM","B","RCDPESP1",21) "BLD",11006,"KRN",9.8,"NM","B","RCDPESP2",26) "BLD",11006,"KRN",9.8,"NM","B","RCDPESP5",27) "BLD",11006,"KRN",9.8,"NM","B","RCDPESP6",8) "BLD",11006,"KRN",9.8,"NM","B","RCDPESP8",10) "BLD",11006,"KRN",9.8,"NM","B","RCDPESPA",24) "BLD",11006,"KRN",9.8,"NM","B","RCDPESR2",4) "BLD",11006,"KRN",9.8,"NM","B","RCDPESR6",6) "BLD",11006,"KRN",9.8,"NM","B","RCDPEU1",17) "BLD",11006,"KRN",9.8,"NM","B","RCDPEU2",35) "BLD",11006,"KRN",9.8,"NM","B","RCDPEUPO",22) "BLD",11006,"KRN",9.8,"NM","B","RCDPEWL0",42) "BLD",11006,"KRN",9.8,"NM","B","RCDPEWL7",18) "BLD",11006,"KRN",9.8,"NM","B","RCDPEWLD",48) "BLD",11006,"KRN",9.8,"NM","B","RCDPEWLP",23) "BLD",11006,"KRN",9.8,"NM","B","RCDPEWLZ",31) "BLD",11006,"KRN",9.8,"NM","B","RCDPEX",47) "BLD",11006,"KRN",9.8,"NM","B","RCDPEX1",7) "BLD",11006,"KRN",9.8,"NM","B","RCDPEX5",5) "BLD",11006,"KRN",9.8,"NM","B","RCDPLPL3",36) "BLD",11006,"KRN",9.8,"NM","B","RCDPLPL4",37) "BLD",11006,"KRN",9.8,"NM","B","RCDPRLIS",11) "BLD",11006,"KRN",9.8,"NM","B","RCDPRPL2",38) "BLD",11006,"KRN",9.8,"NM","B","RCDPRPL4",32) "BLD",11006,"KRN",9.8,"NM","B","RCDPRPLM",33) "BLD",11006,"KRN",9.8,"NM","B","RCDPRSEA",15) "BLD",11006,"KRN",19,0) 19 "BLD",11006,"KRN",19,"NM",0) ^9.68A^56^56 "BLD",11006,"KRN",19,"NM",1,0) RCDPE MARKED AUTO-POST REPORT^^0 "BLD",11006,"KRN",19,"NM",2,0) RCDPE EDI LOCKBOX REPORTS MENU^^0 "BLD",11006,"KRN",19,"NM",3,0) RCDPE EDI LOCKBOX ACT REPORT^^4^ "BLD",11006,"KRN",19,"NM",4,0) RCDPE EFT AGING REPORT^^4^ "BLD",11006,"KRN",19,"NM",5,0) RCDPE ERA AGING REPORT^^4^ "BLD",11006,"KRN",19,"NM",6,0) RCDPE VIEW/PRINT ERA^^4^ "BLD",11006,"KRN",19,"NM",7,0) RCDPE ACTIVE WITH EEOB REPORT^^4^ "BLD",11006,"KRN",19,"NM",8,0) RCDPE REMOVED ERA AUDIT^^4^ "BLD",11006,"KRN",19,"NM",9,0) RCDPE ERA W/PAPER EOB REPORT^^4^ "BLD",11006,"KRN",19,"NM",10,0) RCDPE EFT AUDIT REPORT^^4^ "BLD",11006,"KRN",19,"NM",11,0) RCDPE EEOB MOVE/COPY/RMOVE RPT^^4^ "BLD",11006,"KRN",19,"NM",12,0) RCDPE AUTO-POST REPORT^^4^ "BLD",11006,"KRN",19,"NM",13,0) RCDPE AUTO-DECREASE REPORT^^4^ "BLD",11006,"KRN",19,"NM",14,0) RCDPE PAYER EXCLUSION NAME TIN^^4^ "BLD",11006,"KRN",19,"NM",15,0) RCDPE CARC/RARC TABLE REPORT^^4^ "BLD",11006,"KRN",19,"NM",16,0) RCDPE CARC/RARC QUICK SEARCH^^4^ "BLD",11006,"KRN",19,"NM",17,0) RCDPE PROVIDER LVL ADJ REPORT^^4^ "BLD",11006,"KRN",19,"NM",18,0) RCDPE EFT TRANSACTION AUD REP^^4^ "BLD",11006,"KRN",19,"NM",19,0) RCDPE CARC CODE PAYER REPORT^^4^ "BLD",11006,"KRN",19,"NM",20,0) RCDPE ERA STATUS CHNG AUD REP^^4^ "BLD",11006,"KRN",19,"NM",21,0) RCDPE UNAPPLIED EFT DEP REPORT^^4^ "BLD",11006,"KRN",19,"NM",22,0) RCDPE AUTO-POST RECEIPT REPORT^^4^ "BLD",11006,"KRN",19,"NM",23,0) RCDPE EFT OVERRIDE REPORT^^0^ "BLD",11006,"KRN",19,"NM",24,0) RCDPE EFT-ERA TRENDING REPORT^^4^ "BLD",11006,"KRN",19,"NM",25,0) RCDPE DUPLICATE ERA WORKLIST^^0 "BLD",11006,"KRN",19,"NM",26,0) RCDPE AUTO PARAM HIST REPORT^^0 "BLD",11006,"KRN",19,"NM",27,0) PRCA SITE PARAMETER^^0 "BLD",11006,"KRN",19,"NM",28,0) PRCA NOTIFICATION PARAMETERS^^4^ "BLD",11006,"KRN",19,"NM",29,0) PRCA BIL AGENCY^^4^ "BLD",11006,"KRN",19,"NM",30,0) PRCAF U ADMIN.RATE^^4^ "BLD",11006,"KRN",19,"NM",31,0) PRCA DEACTIVATE GROUP^^4^ "BLD",11006,"KRN",19,"NM",32,0) PRCA RC PARAMETERS^^4^ "BLD",11006,"KRN",19,"NM",33,0) RCDPE EDI LOCKBOX PARAMETERS^^4^ "BLD",11006,"KRN",19,"NM",34,0) PRCA CBO PARAMETERS^^4^ "BLD",11006,"KRN",19,"NM",35,0) RCDPE SITE PARAMETER REPORT^^4^ "BLD",11006,"KRN",19,"NM",36,0) RCDPE PARAMETER AUDIT REPORT^^4^ "BLD",11006,"KRN",19,"NM",37,0) RCDPE EXCLUSION AUDIT REPORT^^4^ "BLD",11006,"KRN",19,"NM",38,0) RCDPE EDI LOCKBOX MENU^^0 "BLD",11006,"KRN",19,"NM",39,0) RCDPE EDI LOCKBOX WORKLIST^^4^ "BLD",11006,"KRN",19,"NM",40,0) RCDPE EXCEPTION PROCESSING^^4^ "BLD",11006,"KRN",19,"NM",41,0) RCDPE MATCH EFT TO ERA^^4^ "BLD",11006,"KRN",19,"NM",42,0) RCDPE MANUAL MATCH EFT-ERA^^0^ "BLD",11006,"KRN",19,"NM",43,0) RCDPE MARK 0-BAL EFT MATCHED^^4^ "BLD",11006,"KRN",19,"NM",44,0) RCDPE ERA POSTED BY PAPER EOB^^4^ "BLD",11006,"KRN",19,"NM",45,0) RCDPE UNMATCH ERA^^4^ "BLD",11006,"KRN",19,"NM",46,0) RCDPE REMOVE ERA FROM WORKLIST^^4^ "BLD",11006,"KRN",19,"NM",47,0) RCDPE REMOVE DUP DEPOSITS^^4^ "BLD",11006,"KRN",19,"NM",48,0) RCDPE UNPOSTED EFT OVERRIDE^^4^ "BLD",11006,"KRN",19,"NM",49,0) RCDPE APAR^^4^ "BLD",11006,"KRN",19,"NM",50,0) RCDPE PAYER IDENTIFY^^4^ "BLD",11006,"KRN",19,"NM",51,0) RCDPE EEOB MOVE/COPY/REMOVE^^4^ "BLD",11006,"KRN",19,"NM",52,0) RCDP EXTENDED CHECK/CC SEARCH^^0 "BLD",11006,"KRN",19,"NM",53,0) RCDPE EDI LOCKBOX ARSRCH RPRTS^^0^ "BLD",11006,"KRN",19,"NM",54,0) RCDPE EDI LOCKBOX ADJCDE RPRTS^^0^ "BLD",11006,"KRN",19,"NM",55,0) RCDPE EDI LOCKBOX AUDIT RPRTS^^0^ "BLD",11006,"KRN",19,"NM",56,0) RCDPE EDI LOCKBOX WORKLD RPRTS^^0^ "BLD",11006,"KRN",19,"NM","B","PRCA BIL AGENCY",29) "BLD",11006,"KRN",19,"NM","B","PRCA CBO PARAMETERS",34) "BLD",11006,"KRN",19,"NM","B","PRCA DEACTIVATE GROUP",31) "BLD",11006,"KRN",19,"NM","B","PRCA NOTIFICATION PARAMETERS",28) "BLD",11006,"KRN",19,"NM","B","PRCA RC PARAMETERS",32) "BLD",11006,"KRN",19,"NM","B","PRCA SITE PARAMETER",27) "BLD",11006,"KRN",19,"NM","B","PRCAF U ADMIN.RATE",30) "BLD",11006,"KRN",19,"NM","B","RCDP EXTENDED CHECK/CC SEARCH",52) "BLD",11006,"KRN",19,"NM","B","RCDPE ACTIVE WITH EEOB REPORT",7) "BLD",11006,"KRN",19,"NM","B","RCDPE APAR",49) "BLD",11006,"KRN",19,"NM","B","RCDPE AUTO PARAM HIST REPORT",26) "BLD",11006,"KRN",19,"NM","B","RCDPE AUTO-DECREASE REPORT",13) "BLD",11006,"KRN",19,"NM","B","RCDPE AUTO-POST RECEIPT REPORT",22) "BLD",11006,"KRN",19,"NM","B","RCDPE AUTO-POST REPORT",12) "BLD",11006,"KRN",19,"NM","B","RCDPE CARC CODE PAYER REPORT",19) "BLD",11006,"KRN",19,"NM","B","RCDPE CARC/RARC QUICK SEARCH",16) "BLD",11006,"KRN",19,"NM","B","RCDPE CARC/RARC TABLE REPORT",15) "BLD",11006,"KRN",19,"NM","B","RCDPE DUPLICATE ERA WORKLIST",25) "BLD",11006,"KRN",19,"NM","B","RCDPE EDI LOCKBOX ACT REPORT",3) "BLD",11006,"KRN",19,"NM","B","RCDPE EDI LOCKBOX ADJCDE RPRTS",54) "BLD",11006,"KRN",19,"NM","B","RCDPE EDI LOCKBOX ARSRCH RPRTS",53) "BLD",11006,"KRN",19,"NM","B","RCDPE EDI LOCKBOX AUDIT RPRTS",55) "BLD",11006,"KRN",19,"NM","B","RCDPE EDI LOCKBOX MENU",38) "BLD",11006,"KRN",19,"NM","B","RCDPE EDI LOCKBOX PARAMETERS",33) "BLD",11006,"KRN",19,"NM","B","RCDPE EDI LOCKBOX REPORTS MENU",2) "BLD",11006,"KRN",19,"NM","B","RCDPE EDI LOCKBOX WORKLD RPRTS",56) "BLD",11006,"KRN",19,"NM","B","RCDPE EDI LOCKBOX WORKLIST",39) "BLD",11006,"KRN",19,"NM","B","RCDPE EEOB MOVE/COPY/REMOVE",51) "BLD",11006,"KRN",19,"NM","B","RCDPE EEOB MOVE/COPY/RMOVE RPT",11) "BLD",11006,"KRN",19,"NM","B","RCDPE EFT AGING REPORT",4) "BLD",11006,"KRN",19,"NM","B","RCDPE EFT AUDIT REPORT",10) "BLD",11006,"KRN",19,"NM","B","RCDPE EFT OVERRIDE REPORT",23) "BLD",11006,"KRN",19,"NM","B","RCDPE EFT TRANSACTION AUD REP",18) "BLD",11006,"KRN",19,"NM","B","RCDPE EFT-ERA TRENDING REPORT",24) "BLD",11006,"KRN",19,"NM","B","RCDPE ERA AGING REPORT",5) "BLD",11006,"KRN",19,"NM","B","RCDPE ERA POSTED BY PAPER EOB",44) "BLD",11006,"KRN",19,"NM","B","RCDPE ERA STATUS CHNG AUD REP",20) "BLD",11006,"KRN",19,"NM","B","RCDPE ERA W/PAPER EOB REPORT",9) "BLD",11006,"KRN",19,"NM","B","RCDPE EXCEPTION PROCESSING",40) "BLD",11006,"KRN",19,"NM","B","RCDPE EXCLUSION AUDIT REPORT",37) "BLD",11006,"KRN",19,"NM","B","RCDPE MANUAL MATCH EFT-ERA",42) "BLD",11006,"KRN",19,"NM","B","RCDPE MARK 0-BAL EFT MATCHED",43) "BLD",11006,"KRN",19,"NM","B","RCDPE MARKED AUTO-POST REPORT",1) "BLD",11006,"KRN",19,"NM","B","RCDPE MATCH EFT TO ERA",41) "BLD",11006,"KRN",19,"NM","B","RCDPE PARAMETER AUDIT REPORT",36) "BLD",11006,"KRN",19,"NM","B","RCDPE PAYER EXCLUSION NAME TIN",14) "BLD",11006,"KRN",19,"NM","B","RCDPE PAYER IDENTIFY",50) "BLD",11006,"KRN",19,"NM","B","RCDPE PROVIDER LVL ADJ REPORT",17) "BLD",11006,"KRN",19,"NM","B","RCDPE REMOVE DUP DEPOSITS",47) "BLD",11006,"KRN",19,"NM","B","RCDPE REMOVE ERA FROM WORKLIST",46) "BLD",11006,"KRN",19,"NM","B","RCDPE REMOVED ERA AUDIT",8) "BLD",11006,"KRN",19,"NM","B","RCDPE SITE PARAMETER REPORT",35) "BLD",11006,"KRN",19,"NM","B","RCDPE UNAPPLIED EFT DEP REPORT",21) "BLD",11006,"KRN",19,"NM","B","RCDPE UNMATCH ERA",45) "BLD",11006,"KRN",19,"NM","B","RCDPE UNPOSTED EFT OVERRIDE",48) "BLD",11006,"KRN",19,"NM","B","RCDPE VIEW/PRINT ERA",6) "BLD",11006,"KRN",19.1,0) 19.1 "BLD",11006,"KRN",19.1,"NM",0) ^9.68A^^ "BLD",11006,"KRN",101,0) 101 "BLD",11006,"KRN",101,"NM",0) ^9.68A^19^19 "BLD",11006,"KRN",101,"NM",1,0) RCDPEX DUP EXCEPTION MENU^^0 "BLD",11006,"KRN",101,"NM",2,0) RCDPEX DELETE DUP MESSAGE^^0 "BLD",11006,"KRN",101,"NM",3,0) RCDPEX FILE DUPLICATE MESSAGE^^0 "BLD",11006,"KRN",101,"NM",4,0) RCDPEX VIEW/PRINT DUP MESSAGE^^0 "BLD",11006,"KRN",101,"NM",5,0) RCDPE EFT ERA MANUAL MATCH^^0 "BLD",11006,"KRN",101,"NM",6,0) RCDPE EFT PARTIAL MATCH MENU^^0 "BLD",11006,"KRN",101,"NM",7,0) RCDPE EFT PARTIAL MATCH SELECT^^0 "BLD",11006,"KRN",101,"NM",8,0) VALM QUIT^^0 "BLD",11006,"KRN",101,"NM",9,0) RCDPE EOB WORKLIST ADMIN COST ADJ^^0 "BLD",11006,"KRN",101,"NM",10,0) RCDPE APAR SELECTED EEOB MENU^^0 "BLD",11006,"KRN",101,"NM",11,0) RCDPE APAR EEOB REFRESH^^0 "BLD",11006,"KRN",101,"NM",12,0) RCDPE MARK FOR AUTOPOST^^4^ "BLD",11006,"KRN",101,"NM",13,0) RCDPE APAR VIEW/PRINT ERA^^4^ "BLD",11006,"KRN",101,"NM",14,0) RCDPE APAR SPLIT LINE^^4^ "BLD",11006,"KRN",101,"NM",15,0) RCDPE APAR VIEW/PRINT EOB^^4^ "BLD",11006,"KRN",101,"NM",16,0) RCDPE APAR RESEARCH^^4^ "BLD",11006,"KRN",101,"NM",17,0) RCDPE APAR VERIFY^^4^ "BLD",11006,"KRN",101,"NM",18,0) VALM BLANK 1^^4^ "BLD",11006,"KRN",101,"NM",19,0) RCDPE APAR CLAIM COMMENT^^4^ "BLD",11006,"KRN",101,"NM","B","RCDPE APAR CLAIM COMMENT",19) "BLD",11006,"KRN",101,"NM","B","RCDPE APAR EEOB REFRESH",11) "BLD",11006,"KRN",101,"NM","B","RCDPE APAR RESEARCH",16) "BLD",11006,"KRN",101,"NM","B","RCDPE APAR SELECTED EEOB MENU",10) "BLD",11006,"KRN",101,"NM","B","RCDPE APAR SPLIT LINE",14) "BLD",11006,"KRN",101,"NM","B","RCDPE APAR VERIFY",17) "BLD",11006,"KRN",101,"NM","B","RCDPE APAR VIEW/PRINT EOB",15) "BLD",11006,"KRN",101,"NM","B","RCDPE APAR VIEW/PRINT ERA",13) "BLD",11006,"KRN",101,"NM","B","RCDPE EFT ERA MANUAL MATCH",5) "BLD",11006,"KRN",101,"NM","B","RCDPE EFT PARTIAL MATCH MENU",6) "BLD",11006,"KRN",101,"NM","B","RCDPE EFT PARTIAL MATCH SELECT",7) "BLD",11006,"KRN",101,"NM","B","RCDPE EOB WORKLIST ADMIN COST ADJ",9) "BLD",11006,"KRN",101,"NM","B","RCDPE MARK FOR AUTOPOST",12) "BLD",11006,"KRN",101,"NM","B","RCDPEX DELETE DUP MESSAGE",2) "BLD",11006,"KRN",101,"NM","B","RCDPEX DUP EXCEPTION MENU",1) "BLD",11006,"KRN",101,"NM","B","RCDPEX FILE DUPLICATE MESSAGE",3) "BLD",11006,"KRN",101,"NM","B","RCDPEX VIEW/PRINT DUP MESSAGE",4) "BLD",11006,"KRN",101,"NM","B","VALM BLANK 1",18) "BLD",11006,"KRN",101,"NM","B","VALM QUIT",8) "BLD",11006,"KRN",409.61,0) 409.61 "BLD",11006,"KRN",409.61,"NM",0) ^9.68A^5^5 "BLD",11006,"KRN",409.61,"NM",1,0) RCDPEX DUPLICATE ERA LIST^^0 "BLD",11006,"KRN",409.61,"NM",2,0) RCDP LIST OF RECEIPTS REPORT^^0 "BLD",11006,"KRN",409.61,"NM",3,0) RCDPE EEOB MARKED FOR AP AUDIT^^0 "BLD",11006,"KRN",409.61,"NM",4,0) RCDPE EFT PARTIAL MATCH^^0 "BLD",11006,"KRN",409.61,"NM",5,0) RCDPE VIEW ERA DETAIL^^0 "BLD",11006,"KRN",409.61,"NM","B","RCDP LIST OF RECEIPTS REPORT",2) "BLD",11006,"KRN",409.61,"NM","B","RCDPE EEOB MARKED FOR AP AUDIT",3) "BLD",11006,"KRN",409.61,"NM","B","RCDPE EFT PARTIAL MATCH",4) "BLD",11006,"KRN",409.61,"NM","B","RCDPE VIEW ERA DETAIL",5) "BLD",11006,"KRN",409.61,"NM","B","RCDPEX DUPLICATE ERA LIST",1) "BLD",11006,"KRN",771,0) 771 "BLD",11006,"KRN",779.2,0) 779.2 "BLD",11006,"KRN",870,0) 870 "BLD",11006,"KRN",8989.51,0) 8989.51 "BLD",11006,"KRN",8989.52,0) 8989.52 "BLD",11006,"KRN",8994,0) 8994 "BLD",11006,"KRN","B",.4,.4) "BLD",11006,"KRN","B",.401,.401) "BLD",11006,"KRN","B",.402,.402) "BLD",11006,"KRN","B",.403,.403) "BLD",11006,"KRN","B",.5,.5) "BLD",11006,"KRN","B",.84,.84) "BLD",11006,"KRN","B",3.6,3.6) "BLD",11006,"KRN","B",3.8,3.8) "BLD",11006,"KRN","B",9.2,9.2) "BLD",11006,"KRN","B",9.8,9.8) "BLD",11006,"KRN","B",19,19) "BLD",11006,"KRN","B",19.1,19.1) "BLD",11006,"KRN","B",101,101) "BLD",11006,"KRN","B",409.61,409.61) "BLD",11006,"KRN","B",771,771) "BLD",11006,"KRN","B",779.2,779.2) "BLD",11006,"KRN","B",870,870) "BLD",11006,"KRN","B",8989.51,8989.51) "BLD",11006,"KRN","B",8989.52,8989.52) "BLD",11006,"KRN","B",8994,8994) "BLD",11006,"QDEF") ^^^^^^^^YES "BLD",11006,"QUES",0) ^9.62^^ "BLD",11006,"REQB",0) ^9.611^4^3 "BLD",11006,"REQB",1,0) PRCA*4.5*326^1 "BLD",11006,"REQB",3,0) PRCA*4.5*319^1 "BLD",11006,"REQB",4,0) PRCA*4.5*315^1 "BLD",11006,"REQB","B","PRCA*4.5*315",4) "BLD",11006,"REQB","B","PRCA*4.5*319",3) "BLD",11006,"REQB","B","PRCA*4.5*326",1) "FIA",342) AR SITE PARAMETER "FIA",342,0) ^RC(342, "FIA",342,0,0) 342P "FIA",342,0,1) y^y^p^^^^n^^n "FIA",342,0,10) "FIA",342,0,11) "FIA",342,0,"RLRO") "FIA",342,0,"VR") 4.5^PRCA "FIA",342,342) 1 "FIA",342,342,7.09) "FIA",344.5) AR EDI LOCKBOX MESSAGES "FIA",344.5,0) ^RCY(344.5, "FIA",344.5,0,0) 344.5 "FIA",344.5,0,1) y^y^p^^^^n^^n "FIA",344.5,0,10) "FIA",344.5,0,11) "FIA",344.5,0,"RLRO") "FIA",344.5,0,"VR") 4.5^PRCA "FIA",344.5,344.5) 1 "FIA",344.5,344.5,.15) "FIA",344.61) RCDPE PARAMETER "FIA",344.61,0) ^RCY(344.61, "FIA",344.61,0,0) 344.61P "FIA",344.61,0,1) y^n^p^^^^n^^n "FIA",344.61,0,10) "FIA",344.61,0,11) "FIA",344.61,0,"RLRO") "FIA",344.61,0,"VR") 4.5^PRCA "FIA",344.61,344.61) 1 "FIA",344.61,344.61,.07) "FIA",344.61,344.61,.13) "FIA",344.61,344.61,2) "FIA",344.61,344.61,26) "FIA",344.61,344.61,27) "FIA",344.61,344.61,28) "FIA",344.61,344.611) 1 "FIA",344.61,344.611,.01) "FIA",344.61,344.611,.02) "FIA",344.61,344.611,1) "FIA",344.61,344.611,2) "FIA",344.61,344.611,3) "FIA",344.61,344.611,4) "INIT") POST^RCP332 "IX",344.61,344.611,"ADU",0) 344.611^ADU^By date and user^R^^R^IR^I^344.611^^^^^S "IX",344.61,344.611,"ADU",.1,0) ^^2^2^3181017^ "IX",344.61,344.611,"ADU",.1,1,0) This new style cross reference by DATE and USER is used to sort the Auto "IX",344.61,344.611,"ADU",.1,2,0) Parameter History Report. "IX",344.61,344.611,"ADU",1) S ^RCY(344.61,DA(1),2,"ADU",X(1),X(2),DA)="" "IX",344.61,344.611,"ADU",2) K ^RCY(344.61,DA(1),2,"ADU",X(1),X(2),DA) "IX",344.61,344.611,"ADU",2.5) K ^RCY(344.61,DA(1),2,"ADU") "IX",344.61,344.611,"ADU",11.1,0) ^.114IA^2^2 "IX",344.61,344.611,"ADU",11.1,1,0) 1^F^344.611^.01^^1^F "IX",344.61,344.611,"ADU",11.1,2,0) 2^F^344.611^.02^^2^F "IX",344.61,344.611,"ADU",11.1,2,2) S X=$$GET1^DIQ(200,X_",",.01,"E") "KRN",19,4294,-1) 4^30 "KRN",19,4294,0) PRCAF U ADMIN.RATE "KRN",19,4374,-1) 4^29 "KRN",19,4374,0) PRCA BIL AGENCY "KRN",19,2913281,-1) 0^27 "KRN",19,2913281,0) PRCA SITE PARAMETER^Site Parameter Edit^^M^^^^^^^^ACCOUNTS RECEIVABLE "KRN",19,2913281,1,0) ^19.06^4^4^3180731^^^^ "KRN",19,2913281,1,1,0) This option will allow the AR Supervisor to edit the site parameters "KRN",19,2913281,1,2,0) for the AR Package. The site parameters allows the system to tailor "KRN",19,2913281,1,3,0) itself for specific site needs, such as: Number of days to purge "KRN",19,2913281,1,4,0) Agent Cashier Receipts, When to generate IRS Offset Letters, etc. "KRN",19,2913281,10,0) ^19.01IP^13^13 "KRN",19,2913281,10,3,0) 2913286^^99 "KRN",19,2913281,10,3,"^") PRCA NOTIFICATION PARAMETERS "KRN",19,2913281,10,4,0) 4374^^40 "KRN",19,2913281,10,4,"^") PRCA BIL AGENCY "KRN",19,2913281,10,5,0) 4294^^45 "KRN",19,2913281,10,5,"^") PRCAF U ADMIN.RATE "KRN",19,2913281,10,6,0) 2914444^^10 "KRN",19,2913281,10,6,"^") PRCA DEACTIVATE GROUP "KRN",19,2913281,10,7,0) 2917347^^90 "KRN",19,2913281,10,7,"^") PRCA RC PARAMETERS "KRN",19,2913281,10,8,0) 2919459^^20 "KRN",19,2913281,10,8,"^") RCDPE EDI LOCKBOX PARAMETERS "KRN",19,2913281,10,9,0) 2919710^^5 "KRN",19,2913281,10,9,"^") PRCA CBO PARAMETERS "KRN",19,2913281,10,10,0) 2922183^^30 "KRN",19,2913281,10,10,"^") RCDPE SITE PARAMETER REPORT "KRN",19,2913281,10,11,0) 2922184^^25 "KRN",19,2913281,10,11,"^") RCDPE PARAMETER AUDIT REPORT "KRN",19,2913281,10,12,0) 2922185^^15 "KRN",19,2913281,10,12,"^") RCDPE EXCLUSION AUDIT REPORT "KRN",19,2913281,10,13,0) 2922540^^35 "KRN",19,2913281,10,13,"^") RCDPE AUTO PARAM HIST REPORT "KRN",19,2913281,99) 64988,77120 "KRN",19,2913281,"U") SITE PARAMETER EDIT "KRN",19,2913286,-1) 4^28 "KRN",19,2913286,0) PRCA NOTIFICATION PARAMETERS "KRN",19,2914444,-1) 4^31 "KRN",19,2914444,0) PRCA DEACTIVATE GROUP "KRN",19,2917347,-1) 4^32 "KRN",19,2917347,0) PRCA RC PARAMETERS "KRN",19,2918319,-1) 0^52 "KRN",19,2918319,0) RCDP EXTENDED CHECK/CC SEARCH^Extended Check/Trace/Credit Card Search^^R^^^^^^^^ACCOUNTS RECEIVABLE "KRN",19,2918319,1,0) ^19.06^2^2^3040302^^ "KRN",19,2918319,1,1,0) This option will search all payments for a check, trace #, or credit card "KRN",19,2918319,1,2,0) number. "KRN",19,2918319,25) RCDPRSEA "KRN",19,2918319,"U") EXTENDED CHECK/TRACE/CREDIT CA "KRN",19,2919459,-1) 4^33 "KRN",19,2919459,0) RCDPE EDI LOCKBOX PARAMETERS "KRN",19,2919461,-1) 4^40 "KRN",19,2919461,0) RCDPE EXCEPTION PROCESSING "KRN",19,2919462,-1) 4^4 "KRN",19,2919462,0) RCDPE EFT AGING REPORT "KRN",19,2919463,-1) 4^5 "KRN",19,2919463,0) RCDPE ERA AGING REPORT "KRN",19,2919464,-1) 4^41 "KRN",19,2919464,0) RCDPE MATCH EFT TO ERA "KRN",19,2919465,-1) 4^39 "KRN",19,2919465,0) RCDPE EDI LOCKBOX WORKLIST "KRN",19,2919467,-1) 0^38 "KRN",19,2919467,0) RCDPE EDI LOCKBOX MENU^EDI Lockbox (ePayments)^^M^^^^^^^^ACCOUNTS RECEIVABLE "KRN",19,2919467,1,0) ^19.06^1^1^3180801^^^^ "KRN",19,2919467,1,1,0) This is the menu that contains the EDI Lockbox functionality. "KRN",19,2919467,10,0) ^19.01IP^19^19 "KRN",19,2919467,10,2,0) 2919465^WL^10 "KRN",19,2919467,10,2,"^") RCDPE EDI LOCKBOX WORKLIST "KRN",19,2919467,10,5,0) 2919461^EXC^5 "KRN",19,2919467,10,5,"^") RCDPE EXCEPTION PROCESSING "KRN",19,2919467,10,6,0) 2919464^MA^20 "KRN",19,2919467,10,6,"^") RCDPE MATCH EFT TO ERA "KRN",19,2919467,10,7,0) 2919470^REP^55 "KRN",19,2919467,10,7,"^") RCDPE EDI LOCKBOX REPORTS MENU "KRN",19,2919467,10,8,0) 2919471^MM^30 "KRN",19,2919467,10,8,"^") RCDPE MANUAL MATCH EFT-ERA "KRN",19,2919467,10,9,0) 2919472^ZB^70 "KRN",19,2919467,10,9,"^") RCDPE MARK 0-BAL EFT MATCHED "KRN",19,2919467,10,11,0) 2919476^UP^65 "KRN",19,2919467,10,11,"^") RCDPE ERA POSTED BY PAPER EOB "KRN",19,2919467,10,12,0) 2919478^UN^60 "KRN",19,2919467,10,12,"^") RCDPE UNMATCH ERA "KRN",19,2919467,10,13,0) 2921657^REM^50 "KRN",19,2919467,10,13,"^") RCDPE REMOVE ERA FROM WORKLIST "KRN",19,2919467,10,14,0) 2922178^MCR^25 "KRN",19,2919467,10,14,"^") RCDPE EEOB MOVE/COPY/REMOVE "KRN",19,2919467,10,15,0) 2921609^REFT^45 "KRN",19,2919467,10,15,"^") RCDPE REMOVE DUP DEPOSITS "KRN",19,2919467,10,16,0) 2922187^OEFT^40 "KRN",19,2919467,10,16,"^") RCDPE UNPOSTED EFT OVERRIDE "KRN",19,2919467,10,17,0) 2922188^APAR^15 "KRN",19,2919467,10,17,"^") RCDPE APAR "KRN",19,2919467,10,18,0) 2922476^IDP^80 "KRN",19,2919467,10,18,"^") RCDPE PAYER IDENTIFY "KRN",19,2919467,10,19,0) 2922539^DUP^42 "KRN",19,2919467,10,19,"^") RCDPE DUPLICATE ERA WORKLIST "KRN",19,2919467,10.1) "KRN",19,2919467,99) 64988,77120 "KRN",19,2919467,99.1) 65015,24801 "KRN",19,2919467,"U") EDI LOCKBOX (EPAYMENTS) "KRN",19,2919468,-1) 4^3 "KRN",19,2919468,0) RCDPE EDI LOCKBOX ACT REPORT "KRN",19,2919470,-1) 0^2 "KRN",19,2919470,0) RCDPE EDI LOCKBOX REPORTS MENU^EDI Lockbox (ePayments) Reports Menu^^M^^^^^^^^ACCOUNTS RECEIVABLE "KRN",19,2919470,1,0) 2^19.06^2^2^3181105^^^^ "KRN",19,2919470,1,1,0) This menu allows access to all the reports that can be produced for EDI "KRN",19,2919470,1,2,0) Lockbox. "KRN",19,2919470,10,0) ^19.01IP^31^31 "KRN",19,2919470,10,6,0) 2919477^VP^25 "KRN",19,2919470,10,6,"^") RCDPE VIEW/PRINT ERA "KRN",19,2919470,10,28,0) 2922544^AUDR^20 "KRN",19,2919470,10,28,"^") RCDPE EDI LOCKBOX AUDIT RPRTS "KRN",19,2919470,10,29,0) 2922547^WORK^5 "KRN",19,2919470,10,29,"^") RCDPE EDI LOCKBOX WORKLD RPRTS "KRN",19,2919470,10,30,0) 2922545^RESR^15 "KRN",19,2919470,10,30,"^") RCDPE EDI LOCKBOX ARSRCH RPRTS "KRN",19,2919470,10,31,0) 2922546^ADJR^10 "KRN",19,2919470,10,31,"^") RCDPE EDI LOCKBOX ADJCDE RPRTS "KRN",19,2919470,99) 64988,77120 "KRN",19,2919470,99.1) 59232,49629 "KRN",19,2919470,"U") EDI LOCKBOX (EPAYMENTS) REPORT "KRN",19,2919471,-1) 0^42 "KRN",19,2919471,0) RCDPE MANUAL MATCH EFT-ERA^EFT Manual Match^^R^^^^^^^^ACCOUNTS RECEIVABLE "KRN",19,2919471,1,0) ^19.06^5^5^3030512^^^^ "KRN",19,2919471,1,1,0) This option will allow the user to choose an EFT detail record and an ERA "KRN",19,2919471,1,2,0) record and will mark the 2 records as matched. This should be used only "KRN",19,2919471,1,3,0) if the automatic matching function is not able to make the match. The "KRN",19,2919471,1,4,0) EFT and ERA selected must both be unmatched and the ERA must not be "KRN",19,2919471,1,5,0) associated with a receipt. "KRN",19,2919471,25) MATCH1^RCDPEM2 "KRN",19,2919471,"U") EFT MANUAL MATCH "KRN",19,2919472,-1) 4^43 "KRN",19,2919472,0) RCDPE MARK 0-BAL EFT MATCHED "KRN",19,2919476,-1) 4^44 "KRN",19,2919476,0) RCDPE ERA POSTED BY PAPER EOB "KRN",19,2919477,-1) 4^6 "KRN",19,2919477,0) RCDPE VIEW/PRINT ERA "KRN",19,2919478,-1) 4^45 "KRN",19,2919478,0) RCDPE UNMATCH ERA "KRN",19,2919710,-1) 4^34 "KRN",19,2919710,0) PRCA CBO PARAMETERS "KRN",19,2919712,-1) 4^7 "KRN",19,2919712,0) RCDPE ACTIVE WITH EEOB REPORT "KRN",19,2921609,-1) 4^47 "KRN",19,2921609,0) RCDPE REMOVE DUP DEPOSITS "KRN",19,2921610,-1) 4^9 "KRN",19,2921610,0) RCDPE ERA W/PAPER EOB REPORT "KRN",19,2921611,-1) 4^10 "KRN",19,2921611,0) RCDPE EFT AUDIT REPORT "KRN",19,2921657,-1) 4^46 "KRN",19,2921657,0) RCDPE REMOVE ERA FROM WORKLIST "KRN",19,2921658,-1) 4^8 "KRN",19,2921658,0) RCDPE REMOVED ERA AUDIT "KRN",19,2922178,-1) 4^51 "KRN",19,2922178,0) RCDPE EEOB MOVE/COPY/REMOVE "KRN",19,2922179,-1) 4^11 "KRN",19,2922179,0) RCDPE EEOB MOVE/COPY/RMOVE RPT "KRN",19,2922181,-1) 4^12 "KRN",19,2922181,0) RCDPE AUTO-POST REPORT "KRN",19,2922182,-1) 4^13 "KRN",19,2922182,0) RCDPE AUTO-DECREASE REPORT "KRN",19,2922183,-1) 4^35 "KRN",19,2922183,0) RCDPE SITE PARAMETER REPORT "KRN",19,2922184,-1) 4^36 "KRN",19,2922184,0) RCDPE PARAMETER AUDIT REPORT "KRN",19,2922185,-1) 4^37 "KRN",19,2922185,0) RCDPE EXCLUSION AUDIT REPORT "KRN",19,2922186,-1) 4^14 "KRN",19,2922186,0) RCDPE PAYER EXCLUSION NAME TIN "KRN",19,2922187,-1) 4^48 "KRN",19,2922187,0) RCDPE UNPOSTED EFT OVERRIDE "KRN",19,2922188,-1) 4^49 "KRN",19,2922188,0) RCDPE APAR "KRN",19,2922295,-1) 4^19 "KRN",19,2922295,0) RCDPE CARC CODE PAYER REPORT "KRN",19,2922296,-1) 4^15 "KRN",19,2922296,0) RCDPE CARC/RARC TABLE REPORT "KRN",19,2922297,-1) 4^17 "KRN",19,2922297,0) RCDPE PROVIDER LVL ADJ REPORT "KRN",19,2922298,-1) 4^18 "KRN",19,2922298,0) RCDPE EFT TRANSACTION AUD REP "KRN",19,2922299,-1) 4^16 "KRN",19,2922299,0) RCDPE CARC/RARC QUICK SEARCH "KRN",19,2922302,-1) 4^24 "KRN",19,2922302,0) RCDPE EFT-ERA TRENDING REPORT "KRN",19,2922310,-1) 4^20 "KRN",19,2922310,0) RCDPE ERA STATUS CHNG AUD REP "KRN",19,2922424,-1) 4^21 "KRN",19,2922424,0) RCDPE UNAPPLIED EFT DEP REPORT "KRN",19,2922451,-1) 4^22 "KRN",19,2922451,0) RCDPE AUTO-POST RECEIPT REPORT "KRN",19,2922476,-1) 4^50 "KRN",19,2922476,0) RCDPE PAYER IDENTIFY "KRN",19,2922537,-1) 0^1 "KRN",19,2922537,0) RCDPE MARKED AUTO-POST REPORT^EEOBs Marked for Auto-Post Audit Report^^R^^^^^^^^ACCOUNTS RECEIVABLE "KRN",19,2922537,1,0) ^^3^3^3180705^ "KRN",19,2922537,1,1,0) The marked for autopost audit report will list the user who marked an EEOB "KRN",19,2922537,1,2,0) for autopost. Lines included in the report are based on filter criteria "KRN",19,2922537,1,3,0) selected at run time by the end user. "KRN",19,2922537,25) EN^RCDPEMAP "KRN",19,2922537,"U") EEOBS MARKED FOR AUTO-POST AUD "KRN",19,2922538,-1) 0^23 "KRN",19,2922538,0) RCDPE EFT OVERRIDE REPORT^Pending EFT Override Report^^R^^^^^^^^ "KRN",19,2922538,1,0) ^^3^3^3180710^ "KRN",19,2922538,1,1,0) This report allows listing by date range of unposted medical "KRN",19,2922538,1,2,0) EFTs that are older than the limit set in the NUMBER OF DAYS (AGE) OF UNPOSTED "KRN",19,2922538,1,3,0) MEDICAL EFTS TO PREVENT POSTING parameter. "KRN",19,2922538,25) EN^RCDPEFTL "KRN",19,2922538,"U") PENDING EFT OVERRIDE REPORT "KRN",19,2922539,-1) 0^25 "KRN",19,2922539,0) RCDPE DUPLICATE ERA WORKLIST^Duplicate ERA Worklist^^A^^^^^^^^^^1 "KRN",19,2922539,1,0) ^^2^2^3180730^ "KRN",19,2922539,1,1,0) Used for the Duplicate ERA Worklist "KRN",19,2922539,1,2,0) See ListMan template: RCDPEX DUPLICATE ERA LIST "KRN",19,2922539,20) D EN1^RCDPEX1 "KRN",19,2922539,"U") DUPLICATE ERA WORKLIST "KRN",19,2922540,-1) 0^26 "KRN",19,2922540,0) RCDPE AUTO PARAM HIST REPORT^Auto Parameter History Report^^R^^^^^^^^ACCOUNTS RECEIVABLE "KRN",19,2922540,25) EN^RCDPESP8 "KRN",19,2922540,"U") AUTO PARAMETER HISTORY REPORT "KRN",19,2922544,-1) 0^55 "KRN",19,2922544,0) RCDPE EDI LOCKBOX AUDIT RPRTS^Audit Reports^^M^^^^^^^^ACCOUNTS RECEIVABLE "KRN",19,2922544,1,0) ^19.06^2^2^3190604^^^^ "KRN",19,2922544,1,1,0) This menu holds the Accounts Receivable /ePayments "KRN",19,2922544,1,2,0) reports related to auditing. "KRN",19,2922544,10,0) ^19.01IP^12^12 "KRN",19,2922544,10,1,0) 2922182^AD^26 "KRN",19,2922544,10,1,"^") RCDPE AUTO-DECREASE REPORT "KRN",19,2922544,10,2,0) 2922181^AP^32 "KRN",19,2922544,10,2,"^") RCDPE AUTO-POST REPORT "KRN",19,2922544,10,3,0) 2922451^APR^36 "KRN",19,2922544,10,3,"^") RCDPE AUTO-POST RECEIPT REPORT "KRN",19,2922544,10,4,0) 2921611^DUPR^48 "KRN",19,2922544,10,4,"^") RCDPE EFT AUDIT REPORT "KRN",19,2922544,10,5,0) 2922310^ESC^52 "KRN",19,2922544,10,5,"^") RCDPE ERA STATUS CHNG AUD REP "KRN",19,2922544,10,6,0) 2922298^ETA^56 "KRN",19,2922544,10,6,"^") RCDPE EFT TRANSACTION AUD REP "KRN",19,2922544,10,7,0) 2922179^MCR^60 "KRN",19,2922544,10,7,"^") RCDPE EEOB MOVE/COPY/RMOVE RPT "KRN",19,2922544,10,8,0) 2922537^EMA^64 "KRN",19,2922544,10,8,"^") RCDPE MARKED AUTO-POST REPORT "KRN",19,2922544,10,9,0) 2921610^POSR^72 "KRN",19,2922544,10,9,"^") RCDPE ERA W/PAPER EOB REPORT "KRN",19,2922544,10,10,0) 2922186^PX^76 "KRN",19,2922544,10,10,"^") RCDPE PAYER EXCLUSION NAME TIN "KRN",19,2922544,10,11,0) 2921658^REMR^84 "KRN",19,2922544,10,11,"^") RCDPE REMOVED ERA AUDIT "KRN",19,2922544,10,12,0) 2922540^APH^40 "KRN",19,2922544,10,12,"^") RCDPE AUTO PARAM HIST REPORT "KRN",19,2922544,99) 65168,52300 "KRN",19,2922544,"U") AUDIT REPORTS "KRN",19,2922545,-1) 0^53 "KRN",19,2922545,0) RCDPE EDI LOCKBOX ARSRCH RPRTS^Additional Research Reports^^M^^^^^^^^ACCOUNTS RECEIVABLE "KRN",19,2922545,1,0) ^19.06^2^2^3181105^^ "KRN",19,2922545,1,1,0) This menu holds the Accounts Receivable /ePayments "KRN",19,2922545,1,2,0) Additional Research reports. "KRN",19,2922545,10,0) ^19.01IP^2^2 "KRN",19,2922545,10,1,0) 2922302^ETR^20 "KRN",19,2922545,10,1,"^") RCDPE EFT-ERA TRENDING REPORT "KRN",19,2922545,10,2,0) 2919712^AB^28 "KRN",19,2922545,10,2,"^") RCDPE ACTIVE WITH EEOB REPORT "KRN",19,2922545,99) 64988,77120 "KRN",19,2922545,"U") ADDITIONAL RESEARCH REPORTS "KRN",19,2922546,-1) 0^54 "KRN",19,2922546,0) RCDPE EDI LOCKBOX ADJCDE RPRTS^Adjustment Code Reports^^M^^^^^^^^ACCOUNTS RECEIVABLE "KRN",19,2922546,1,0) ^19.06^2^2^3181105^^ "KRN",19,2922546,1,1,0) This menu holds the Accounts Receivable /ePayments "KRN",19,2922546,1,2,0) Adjustment Code reports. "KRN",19,2922546,10,0) ^19.01IP^4^4 "KRN",19,2922546,10,1,0) 2922295^CR^44 "KRN",19,2922546,10,1,"^") RCDPE CARC CODE PAYER REPORT "KRN",19,2922546,10,2,0) 2922297^PLB^68 "KRN",19,2922546,10,2,"^") RCDPE PROVIDER LVL ADJ REPORT "KRN",19,2922546,10,3,0) 2922299^QS^80 "KRN",19,2922546,10,3,"^") RCDPE CARC/RARC QUICK SEARCH "KRN",19,2922546,10,4,0) 2922296^TB^88 "KRN",19,2922546,10,4,"^") RCDPE CARC/RARC TABLE REPORT "KRN",19,2922546,99) 64988,77120 "KRN",19,2922546,"U") ADJUSTMENT CODE REPORTS "KRN",19,2922547,-1) 0^56 "KRN",19,2922547,0) RCDPE EDI LOCKBOX WORKLD RPRTS^Workload Reports^^M^^^^^^^^ACCOUNTS RECEIVABLE "KRN",19,2922547,1,0) ^19.06^1^1^3181105^^^ "KRN",19,2922547,1,1,0) This menu holds the Accounts Receivable /ePayments Workload reports. "KRN",19,2922547,10,0) ^19.01IP^5^5 "KRN",19,2922547,10,1,0) 2919468^DA^4 "KRN",19,2922547,10,1,"^") RCDPE EDI LOCKBOX ACT REPORT "KRN",19,2922547,10,2,0) 2919462^EFT^8 "KRN",19,2922547,10,2,"^") RCDPE EFT AGING REPORT "KRN",19,2922547,10,3,0) 2919463^ERA^12 "KRN",19,2922547,10,3,"^") RCDPE ERA AGING REPORT "KRN",19,2922547,10,4,0) 2922538^PEO^16 "KRN",19,2922547,10,4,"^") RCDPE EFT OVERRIDE REPORT "KRN",19,2922547,10,5,0) 2922424^UN^24 "KRN",19,2922547,10,5,"^") RCDPE UNAPPLIED EFT DEP REPORT "KRN",19,2922547,99) 64988,77120 "KRN",19,2922547,"U") WORKLOAD REPORTS "KRN",101,1697,-1) 0^8 "KRN",101,1697,0) VALM QUIT^Quit^^A^^^^^^^^ "KRN",101,1697,.1) "KRN",101,1697,1,0) ^^1^1^2911105^ "KRN",101,1697,1,1,0) This protocol can be used as a generic 'quit' action. "KRN",101,1697,2,0) ^101.02A^2^2 "KRN",101,1697,2,1,0) EXIT "KRN",101,1697,2,2,0) QUIT "KRN",101,1697,2,"B","EXIT",1) "KRN",101,1697,2,"B","QUIT",2) "KRN",101,1697,15) "KRN",101,1697,20) Q "KRN",101,1697,99) 64988,77120 "KRN",101,1702,-1) 4^18 "KRN",101,1702,0) VALM BLANK 1 "KRN",101,7602,-1) 0^9 "KRN",101,7602,0) RCDPE EOB WORKLIST ADMIN COST ADJ^Admin Cost Adj^^A^^^^^^^^ACCOUNTS RECEIVABLE "KRN",101,7602,1,0) ^101.06^1^1^3170327^^^ "KRN",101,7602,1,1,0) Used to adjust the administrative costs, IRS cost, DMV cost, etc "KRN",101,7602,15) S VALMBCK="R" K PRCASUP "KRN",101,7602,20) S PRCASUP=1 D FULL^VALM1 D EN1^PRCAEXM(1) K DTOUT "KRN",101,7602,99) 64988,77120 "KRN",101,7963,-1) 4^13 "KRN",101,7963,0) RCDPE APAR VIEW/PRINT ERA "KRN",101,7965,-1) 0^10 "KRN",101,7965,0) RCDPE APAR SELECTED EEOB MENU^APAR Selected EEOB^^M^^^^^^^^ACCOUNTS RECEIVABLE "KRN",101,7965,1,0) ^101.06^3^3^3181004^^^^ "KRN",101,7965,1,1,0) The APAR selected EEOB menu contains the actions that can be performed "KRN",101,7965,1,2,0) manually on the EEOB item that did not get a receipt when the associated "KRN",101,7965,1,3,0) ERA record was processed during the auto-post nightly process. "KRN",101,7965,4) 25^4 "KRN",101,7965,10,0) ^101.01PA^21^21 "KRN",101,7965,10,1,0) 1697^^999^^^EXIT "KRN",101,7965,10,1,"^") VALM QUIT "KRN",101,7965,10,3,0) 7966^^100^ "KRN",101,7965,10,3,"^") RCDPE MARK FOR AUTOPOST "KRN",101,7965,10,10,0) 7963^ERA^220^ "KRN",101,7965,10,10,"^") RCDPE APAR VIEW/PRINT ERA "KRN",101,7965,10,11,0) 7967^^50^ "KRN",101,7965,10,11,"^") RCDPE APAR SPLIT LINE "KRN",101,7965,10,13,0) 7969^^240^^^Research Menu "KRN",101,7965,10,13,"^") RCDPE APAR RESEARCH "KRN",101,7965,10,14,0) 7968^^310^ "KRN",101,7965,10,14,"^") RCDPE APAR EEOB REFRESH "KRN",101,7965,10,15,0) 7971^EOB^210^ "KRN",101,7965,10,15,"^") RCDPE APAR VIEW/PRINT EOB "KRN",101,7965,10,16,0) 7973^^320^^^ "KRN",101,7965,10,16,"^") RCDPE APAR VERIFY "KRN",101,7965,10,19,0) 1702^^250^ "KRN",101,7965,10,19,"^") VALM BLANK 1 "KRN",101,7965,10,20,0) 8017^^150^ "KRN",101,7965,10,20,"^") RCDPE APAR CLAIM COMMENT "KRN",101,7965,10,21,0) 1702^^170^ "KRN",101,7965,10,21,"^") VALM BLANK 1 "KRN",101,7965,15) I $G(RCFASTXT) S VALMBCK="Q" "KRN",101,7965,26) D SHOW^VALM "KRN",101,7965,28) Select Action: "KRN",101,7965,99) 64988,77120 "KRN",101,7966,-1) 4^12 "KRN",101,7966,0) RCDPE MARK FOR AUTOPOST "KRN",101,7967,-1) 4^14 "KRN",101,7967,0) RCDPE APAR SPLIT LINE "KRN",101,7968,-1) 0^11 "KRN",101,7968,0) RCDPE APAR EEOB REFRESH^Refresh Line^^A^^^^^^^^ACCOUNTS RECEIVABLE "KRN",101,7968,1,0) ^101.06^3^3^3181004^^^^ "KRN",101,7968,1,1,0) This option allows the user to 'refresh' the APAR scratch pad entry to "KRN",101,7968,1,2,0) remove all previously entered edits/splits/adjustments and restore it to "KRN",101,7968,1,3,0) the state it was in before any manual changes were made. "KRN",101,7968,4) ^^^ "KRN",101,7968,20) D REFRESH^RCDPEAA3(RCIENS) "KRN",101,7968,99) 64988,77120 "KRN",101,7969,-1) 4^16 "KRN",101,7969,0) RCDPE APAR RESEARCH "KRN",101,7971,-1) 4^15 "KRN",101,7971,0) RCDPE APAR VIEW/PRINT EOB "KRN",101,7973,-1) 4^17 "KRN",101,7973,0) RCDPE APAR VERIFY "KRN",101,8008,-1) 0^5 "KRN",101,8008,0) RCDPE EFT ERA MANUAL MATCH^ERA Manual Match^^A^^^^^^^^ACCOUNTS RECEIVABLE "KRN",101,8008,20) D MATCHWL^RCDPEM2 "KRN",101,8008,28) Manual Match "KRN",101,8008,99) 64988,77120 "KRN",101,8017,-1) 4^19 "KRN",101,8017,0) RCDPE APAR CLAIM COMMENT "KRN",101,8438,-1) 0^1 "KRN",101,8438,0) RCDPEX DUP EXCEPTION MENU^Duplicate 835ERA Messages^^M^^^^^^^^ACCOUNTS RECEIVABLE "KRN",101,8438,1,0) ^101.06^2^2^3180801^^^^ "KRN",101,8438,1,1,0) This is the main menu that contains the actions that can be "KRN",101,8438,1,2,0) manually performed on duplicate ERA messages "KRN",101,8438,4) 40^6 "KRN",101,8438,10,0) ^101.01PA^4^4 "KRN",101,8438,10,1,0) 1697^Q^100^^^Exit "KRN",101,8438,10,1,"^") VALM QUIT "KRN",101,8438,10,2,0) 8439^DM^30^ "KRN",101,8438,10,2,"^") RCDPEX DELETE DUP MESSAGE "KRN",101,8438,10,3,0) 8440^FM^20^ "KRN",101,8438,10,3,"^") RCDPEX FILE DUPLICATE MESSAGE "KRN",101,8438,10,4,0) 8441^VP^10^ "KRN",101,8438,10,4,"^") RCDPEX VIEW/PRINT DUP MESSAGE "KRN",101,8438,15) I $G(RCFASTXT) S VALMBCK="Q" "KRN",101,8438,26) D SHOW^VALM "KRN",101,8438,28) Select Action: "KRN",101,8438,99) 64988,77120 "KRN",101,8439,-1) 0^2 "KRN",101,8439,0) RCDPEX DELETE DUP MESSAGE^Delete Dup Message^^A^^RCDPE ERA EXCEPT^^^^^^ACCOUNTS RECEIVABLE "KRN",101,8439,1,0) ^101.06^4^4^3180730^^ "KRN",101,8439,1,1,0) This action allows a user to manually delete a duplicate ERA message "KRN",101,8439,1,2,0) that either cannot continue, or is not wanted to continue, "KRN",101,8439,1,3,0) through the EDI Lockbox message process. "KRN",101,8439,1,4,0) A MailMan message is sent to alert that this action has been taken. "KRN",101,8439,20) D DEL^RCDPEX5 "KRN",101,8439,99) 64988,77120 "KRN",101,8440,-1) 0^3 "KRN",101,8440,0) RCDPEX FILE DUPLICATE MESSAGE^File Message^^A^^^^^^^^ "KRN",101,8440,1,0) ^101.06^2^2^3180801^^ "KRN",101,8440,1,1,0) This action allows a user to manually force a duplicate "KRN",101,8440,1,2,0) ERA message to process through the EDI Lockbox ERA/EOB file process. "KRN",101,8440,4) ^6 "KRN",101,8440,20) D UPD^RCDPEX5 "KRN",101,8440,99) 64988,77120 "KRN",101,8441,-1) 0^4 "KRN",101,8441,0) RCDPEX VIEW/PRINT DUP MESSAGE^View/Print Dup. Message^^A^^^^^^^^ACCOUNTS RECEIVABLE "KRN",101,8441,1,0) ^^2^2^3180730^ "KRN",101,8441,1,1,0) This action allows the user to view a duplicate EDI Lockbox "KRN",101,8441,1,2,0) ERA message. "KRN",101,8441,20) D VP^RCDPEX5 "KRN",101,8441,99) 64988,77120 "KRN",101,8454,-1) 0^7 "KRN",101,8454,0) RCDPE EFT PARTIAL MATCH SELECT^Select EFT^^A^^^^^^^^ACCOUNTS RECEIVABLE "KRN",101,8454,2,0) ^101.02A^1^1 "KRN",101,8454,2,1,0) SE "KRN",101,8454,2,"B","SE",1) "KRN",101,8454,4) 26^4 "KRN",101,8454,20) D SELEFT^RCDPEE "KRN",101,8454,99) 64988,77120 "KRN",101,8455,-1) 0^6 "KRN",101,8455,0) RCDPE EFT PARTIAL MATCH MENU^^^M^^^^^^^^ACCOUNTS RECEIVABLE "KRN",101,8455,4) 26^4 "KRN",101,8455,10,0) ^101.01PA^2^2 "KRN",101,8455,10,1,0) 8454^SE^10^^^Select EFT "KRN",101,8455,10,1,"^") RCDPE EFT PARTIAL MATCH SELECT "KRN",101,8455,10,2,0) 1697^^200^^^EXIT "KRN",101,8455,10,2,"^") VALM QUIT "KRN",101,8455,15) "KRN",101,8455,26) D SHOW^VALM "KRN",101,8455,28) Select Action: "KRN",101,8455,99) 64988,77120 "KRN",409.61,796,-1) 0^2 "KRN",409.61,796,0) RCDP LIST OF RECEIPTS REPORT^1^^85^6^20^1^1^^RCDP LIST OF RECEIPTS MENU^LIST OF RECEIPTS^1^^1 "KRN",409.61,796,1) ^VALM HIDDEN ACTIONS "KRN",409.61,796,"ARRAY") "KRN",409.61,796,"COL",0) ^409.621^9^9 "KRN",409.61,796,"COL",1,0) DATE OPENED^7^8^DATE "KRN",409.61,796,"COL",2,0) RECEIPT^16^12^RECEIPT "KRN",409.61,796,"COL",3,0) TYPE^29^5^TYPE "KRN",409.61,796,"COL",4,0) USER INITIALS^35^7^USER "KRN",409.61,796,"COL",5,0) COUNT^43^5^COUNT "KRN",409.61,796,"COL",6,0) AMOUNT^53^6^AMOUNT "KRN",409.61,796,"COL",7,0) FMS DOC^61^13^FMS CR DOC "KRN",409.61,796,"COL",8,0) STATUS^75^6^STATUS "KRN",409.61,796,"COL",9,0) LINE^1^4^ # "KRN",409.61,796,"COL","B","AMOUNT",6) "KRN",409.61,796,"COL","B","COUNT",5) "KRN",409.61,796,"COL","B","DATE OPENED",1) "KRN",409.61,796,"COL","B","FMS DOC",7) "KRN",409.61,796,"COL","B","LINE",9) "KRN",409.61,796,"COL","B","RECEIPT",2) "KRN",409.61,796,"COL","B","STATUS",8) "KRN",409.61,796,"COL","B","TYPE",3) "KRN",409.61,796,"COL","B","USER INITIALS",4) "KRN",409.61,796,"FNL") D EXIT^RCDPRL "KRN",409.61,796,"HDR") D HDR^RCDPRL "KRN",409.61,796,"HLP") D HELP^RCDPRL "KRN",409.61,796,"INIT") D INIT^RCDPRL "KRN",409.61,806,-1) 0^1 "KRN",409.61,806,0) RCDPEX DUPLICATE ERA LIST^1^^80^5^19^1^1^EDI Lockbox Duplicate ERA^RCDPEX DUP EXCEPTION MENU^DUPLICATE ERA TRANSMISSIONS^1^^1 "KRN",409.61,806,1) ^VALM HIDDEN ACTIONS "KRN",409.61,806,"ARRAY") ^TMP("RCDPEX-EOB",$J) "KRN",409.61,806,"COL",0) ^409.621^5^5 "KRN",409.61,806,"COL",1,0) NUMBER^1^4^# "KRN",409.61,806,"COL",2,0) MSG_ID^7^20^Message ID "KRN",409.61,806,"COL",3,0) MSG_TYPE^29^7^MsgType "KRN",409.61,806,"COL",4,0) REC_DATE^38^20^Date Received "KRN",409.61,806,"COL",5,0) MAIL MESSAGE #^60^17^Mail Message # "KRN",409.61,806,"COL","B","MAIL MESSAGE #",5) "KRN",409.61,806,"COL","B","MSG_ID",2) "KRN",409.61,806,"COL","B","MSG_TYPE",3) "KRN",409.61,806,"COL","B","NUMBER",1) "KRN",409.61,806,"COL","B","REC_DATE",4) "KRN",409.61,806,"FNL") D FNL^RCDPEX1 "KRN",409.61,806,"HDR") D HDR1^RCDPEX1 "KRN",409.61,806,"INIT") D INITD^RCDPEX1 "KRN",409.61,808,-1) 0^3 "KRN",409.61,808,0) RCDPE EEOB MARKED FOR AP AUDIT^2^^80^7^21^1^1^^^EEOBs MARKED FOR AP AUDIT^1^^1 "KRN",409.61,808,1) ^VALM HIDDEN ACTIONS "KRN",409.61,808,"FNL") D LMEXIT^RCDPEARL "KRN",409.61,808,"HDR") D LMHDR^RCDPEARL "KRN",409.61,808,"HLP") D LMHLP^RCDPEARL "KRN",409.61,808,"INIT") D LMINIT^RCDPEARL "KRN",409.61,809,-1) 0^4 "KRN",409.61,809,0) RCDPE EFT PARTIAL MATCH^1^^80^9^20^1^1^^RCDPE EFT PARTIAL MATCH MENU^EFT Selection^1^^1 "KRN",409.61,809,1) ^VALM HIDDEN ACTIONS "KRN",409.61,809,"ARRAY") ^TMP("RCPM-WL",$J) "KRN",409.61,809,"COL",0) ^409.621^1^1 "KRN",409.61,809,"COL",1,0) PAYER NAME/TIN^7^73^Payer Name/TIN "KRN",409.61,809,"COL","B","PAYER NAME/TIN",1) "KRN",409.61,809,"FNL") D EXIT^RCDPEE "KRN",409.61,809,"HDR") D HDR^RCDPEE "KRN",409.61,809,"HLP") D HELP^RCDPEE "KRN",409.61,809,"INIT") D INIT^RCDPEE "KRN",409.61,811,-1) 0^5 "KRN",409.61,811,0) RCDPE VIEW ERA DETAIL^2^^80^2^21^0^1^^^View ERA Detail^1^^1 "KRN",409.61,811,1) ^VALM HIDDEN ACTIONS "KRN",409.61,811,"FNL") D LMEXIT^RCDPEARL "KRN",409.61,811,"HDR") D LMHDR^RCDPEARL "KRN",409.61,811,"HLP") D LMHLP^RCDPEARL "KRN",409.61,811,"INIT") D LMINIT^RCDPEARL "MBREQ") 1 "ORD",15,101) 101;15;;;PRO^XPDTA;PROF1^XPDIA;PROE1^XPDIA;PROF2^XPDIA;;PRODEL^XPDIA "ORD",15,101,0) PROTOCOL "ORD",17,409.61) 409.61;17;1;;;;LME1^XPDIA1;;;LMDEL^XPDIA1 "ORD",17,409.61,0) LIST TEMPLATE "ORD",18,19) 19;18;;;OPT^XPDTA;OPTF1^XPDIA;OPTE1^XPDIA;OPTF2^XPDIA;;OPTDEL^XPDIA "ORD",18,19,0) OPTION "PKG",561,-1) 1^1 "PKG",561,0) ACCOUNTS RECEIVABLE^PRCA^FMS "PKG",561,22,0) ^9.49I^1^1 "PKG",561,22,1,0) 4.5^2950320^2950331 "PKG",561,22,1,"PAH",1,0) 332^3190606^520824650 "PKG",561,22,1,"PAH",1,1,0) ^^1^1^3190606 "PKG",561,22,1,"PAH",1,1,1,0) MCCF EDI TAS EPAYMENTS BUILD 3 "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") YES "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") 48 "RTN","PRCABJ2") 0^39^B20492059 "RTN","PRCABJ2",1,0) PRCABJ2 ;OIT/hrub - NIGHTLY PROCESS FOR ACCOUNTS RECEIVABLE ;31 Oct 2018 16:00:59 "RTN","PRCABJ2",2,0) ;;4.5;Accounts Receivable;**304,321,326,332**;Mar 20, 1995;Build 40 "RTN","PRCABJ2",3,0) ;Per VA Directive 6402, this routine should not be modified. "RTN","PRCABJ2",4,0) ; "RTN","PRCABJ2",5,0) ; read of ^DGCR(399.2 allowed by DBIA 3822 "RTN","PRCABJ2",6,0) ; refactored 17 October 2018, PRCA*4.5*332 "RTN","PRCABJ2",7,0) Q "RTN","PRCABJ2",8,0) ; Auto-audit Paper, Electronic, and Tricare bills if ready "RTN","PRCABJ2",9,0) ; PRCA*4.5*332 - Whole subroutine re-written "RTN","PRCABJ2",10,0) ABAUDIT ; "RTN","PRCABJ2",11,0) ; APIEN - Accounts Payable (file #430) ien (also same ien for file #399) "RTN","PRCABJ2",12,0) N APIEN,ARBILL,C,FLAG,J,PRCA,RTYPE ;PRCA*4.5*321, PRCA*4.5*332 "RTN","PRCABJ2",13,0) ; "RTN","PRCABJ2",14,0) S ARBILL("newBillIEN")=$O(^PRCA(430.3,"B","NEW BILL","")) ; New Bill IEN "RTN","PRCABJ2",15,0) Q:ARBILL("newBillIEN")="" ; must have the IEN for new bills "RTN","PRCABJ2",16,0) ; Check parameters to see if audit needs to run "RTN","PRCABJ2",17,0) S FLAG("aaMedPaper")=$$GET1^DIQ(342,"1,",7.05,"I") ; (#7.05) AUTO-AUDIT MEDICAL PAPER BILLS [5S] "RTN","PRCABJ2",18,0) S FLAG("aaRxPaper")=$$GET1^DIQ(342,"1,",7.06,"I") ; (#7.06) AUTO-AUDIT RX PAPER BILLS [6S] "RTN","PRCABJ2",19,0) S FLAG("aaMedEDI")=$$GET1^DIQ(342,"1,",7.07,"I") ; (#7.07) AUTO-AUDIT MEDICAL EDI BILLS [7S] - PRCA*4.5*321 "RTN","PRCABJ2",20,0) S FLAG("aaRxEDI")=$$GET1^DIQ(342,"1,",7.08,"I") ; (#7.08) AUTO-AUDIT RX EDI BILLS [8S] - PRCA*4.5*321 "RTN","PRCABJ2",21,0) S FLAG("aaTricare")=$$GET1^DIQ(342,"1,",7.09,"I") ; (#7.09) AUTO-AUDIT TRICARE BILLS [9S] - PRCA*4.5*332 "RTN","PRCABJ2",22,0) ; quit if all auto-audit parameters are 'No' "RTN","PRCABJ2",23,0) Q:('FLAG("aaMedPaper"))&('FLAG("aaRxPaper"))&('FLAG("aaMedEDI"))&('FLAG("aaRxEDI"))&('FLAG("aaTricare")) ; PRCA*4.5*321 "RTN","PRCABJ2",24,0) ; "RTN","PRCABJ2",25,0) ; RTYPE - array of RATE TYPE entries that have (#.11) BILL RESULTING FROM [11P:430.6] - PRCA*4.5*332 "RTN","PRCABJ2",26,0) S C=0 F S C=$O(^DGCR(399.3,C)) Q:'C S J=$G(^(C,0)) S:$P(J,U,11) RTYPE(C)=J "RTN","PRCABJ2",27,0) ; loop through new bills "RTN","PRCABJ2",28,0) ; BILL - info for this bill "RTN","PRCABJ2",29,0) ; PRCA - bill # and ECME info "RTN","PRCABJ2",30,0) ; RTDGCR - used for file #399 info (except rate type) "RTN","PRCABJ2",31,0) S APIEN="" F S APIEN=$O(^PRCA(430,"AC",ARBILL("newBillIEN"),APIEN)) Q:'APIEN D "RTN","PRCABJ2",32,0) . N BILL,PRCA,RTDGCR "RTN","PRCABJ2",33,0) . ; "RTN","PRCABJ2",34,0) . S BILL("rtTyp")=$$GET1^DIQ(399,APIEN_",",.07,"I") ; (#.07) RATE TYPE [7P:399.3] - PRCA*4.5*326 "RTN","PRCABJ2",35,0) . Q:'BILL("rtTyp") ; must have rate type "RTN","PRCABJ2",36,0) . Q:'$D(RTYPE(BILL("rtTyp"))) ; no auto-audit for this RATE TYPE "RTN","PRCABJ2",37,0) . ; BEGIN - PRCA*4.5*321 "RTN","PRCABJ2",38,0) . Q:$$GET1^DIQ(430,APIEN_",",7,"I")="" ; quit if no (#7) PATIENT [7P:2] "RTN","PRCABJ2",39,0) . Q:$$GET1^DIQ(430,APIEN_",",9,"I")="" ; quit if no (#9) DEBTOR [9P:340] "RTN","PRCABJ2",40,0) . Q:$$GET1^DIQ(430,APIEN_",",239,"I")="" ; quit if no (#239) INSURED NAME [1F] "RTN","PRCABJ2",41,0) . Q:$$GET1^DIQ(430,APIEN_",",243,"I")="" ; quit if no (#243) GROUP NAME [5F] "RTN","PRCABJ2",42,0) . Q:$$GET1^DIQ(430,APIEN_",",244,"I")="" ; quit if no (#244) GROUP NUMBER [6F] "RTN","PRCABJ2",43,0) . Q:$$BILLREJ^PRCAUDT(APIEN) ; PRCA*4.5*321 - claim has reject messages, do not audit "RTN","PRCABJ2",44,0) . ; "RTN","PRCABJ2",45,0) . S RTDGCR("type")=$$GET1^DIQ(399,APIEN_",",.07,"E") ; (#.07) RATE TYPE [7P:399.3] (IA 4118) "RTN","PRCABJ2",46,0) . S RTDGCR("paper")=$$GET1^DIQ(399,APIEN_",",27,"I") ; (#.27) BILL CHARGE TYPE [27S] (ICR 3820) "RTN","PRCABJ2",47,0) . S BILL("audit?")=0 ; Boolean flag, need to audit bill? "RTN","PRCABJ2",48,0) . S BILL("doneCheck?")=0 ; Boolean flag, done checking? "RTN","PRCABJ2",49,0) . ; Get Bill number to check if it's a Pharmacy bill "RTN","PRCABJ2",50,0) . S PRCA("bill#")=$$GET1^DIQ(430,APIEN_",",.01,"I") ; (#.01) BILL NO. [1F] "RTN","PRCABJ2",51,0) . S PRCA("ecme#")=$$GETECME^RCDPENR1(APIEN) ; ECME# from the bill "RTN","PRCABJ2",52,0) . ; "RTN","PRCABJ2",53,0) . I PRCA("ecme#")'="" D ; has ECME#, check pharmacy flags "RTN","PRCABJ2",54,0) .. I RTDGCR("paper"),'FLAG("aaRxPaper") S BILL("doneCheck?")=1 Q ; Skip paper bill if No auto-audit "RTN","PRCABJ2",55,0) .. I 'RTDGCR("paper"),'FLAG("aaRxEDI") S BILL("doneCheck?")=1 Q ; Skip EDI bill if No auto-audit "RTN","PRCABJ2",56,0) .. S BILL("audit?")="1^pharmacy" ; audit this pharmacy bill "RTN","PRCABJ2",57,0) . ; "RTN","PRCABJ2",58,0) . I BILL("audit?") D AUDITX^PRCAUDT(APIEN) Q ; audit pharmacy bill, continue loop "RTN","PRCABJ2",59,0) . Q:BILL("doneCheck?") ; done checking, continue loop through bills "RTN","PRCABJ2",60,0) . ; "RTN","PRCABJ2",61,0) . I RTDGCR("type")["TRICARE" D "RTN","PRCABJ2",62,0) .. I FLAG("aaTricare") S BILL("audit?")="1^Tricare" ; audit this Tricare bill "RTN","PRCABJ2",63,0) .. S BILL("doneCheck?")=1 "RTN","PRCABJ2",64,0) . I BILL("audit?") D AUDITX^PRCAUDT(APIEN) Q ; audit Tricare bill, continue loop "RTN","PRCABJ2",65,0) . Q:BILL("doneCheck?") ; done checking, continue loop through bills "RTN","PRCABJ2",66,0) . D ; medical bill, check medical flags "RTN","PRCABJ2",67,0) .. I RTDGCR("paper"),'FLAG("aaMedPaper") S BILL("doneCheck?")=1 Q ; Skip paper bill if No auto-audit "RTN","PRCABJ2",68,0) .. I 'RTDGCR("paper"),'FLAG("aaMedEDI") S BILL("doneCheck?")=1 Q ; Skip EDI bill if No auto-audit "RTN","PRCABJ2",69,0) .. S BILL("audit?")="1^medical" ; audit this medical bill "RTN","PRCABJ2",70,0) . Q:BILL("doneCheck?") ; no auto-audit for medical bill "RTN","PRCABJ2",71,0) . ; passed medical checks call auto-audit for this Bill "RTN","PRCABJ2",72,0) . I BILL("audit?") D AUDITX^PRCAUDT(APIEN) "RTN","PRCABJ2",73,0) ; "RTN","PRCABJ2",74,0) Q "RTN","PRCABJ2",75,0) ; "RTN","PRCAEXM") 0^40^B15458126 "RTN","PRCAEXM",1,0) PRCAEXM ;SF-ISC/YJK-ADMIN.COST CHARGE TRANSACTION ;15 Nov 2018 13:51:18 "RTN","PRCAEXM",2,0) ;;4.5;Accounts Receivable;**67,103,196,301,318,315,332**;Mar 20, 1995;Build 40 "RTN","PRCAEXM",3,0) ;Per VA Directive 6402, this routine should not be modified. "RTN","PRCAEXM",4,0) ; "RTN","PRCAEXM",5,0) ;Update Int/adm.balance and Administrative cost charge transaction, is called by ^PRCAWO. "RTN","PRCAEXM",6,0) ; "RTN","PRCAEXM",7,0) D EN1(0) ; Administrative Cost Adjustment [PRCAF ADJ ADMIN] option entry point, PRCA*4.5*332 "RTN","PRCAEXM",8,0) Q "RTN","PRCAEXM",9,0) ; "RTN","PRCAEXM",10,0) EN1(KEYCHK) ;Adjustment Interest/admin.cost from an AR - this makes the int/adm.balance "RTN","PRCAEXM",11,0) ; ,marshal fee and court cost zero,0. "RTN","PRCAEXM",12,0) ; KEYCHK (optional) - 1 check for RCDPEAR security key, zero otherwise, defaults to zero "RTN","PRCAEXM",13,0) N PRCAIND,ADMINTOT,PRCAERR,PRCABN0 "RTN","PRCAEXM",14,0) I '$D(KEYCHK) N KEYCHK S KEYCHK=0 "RTN","PRCAEXM",15,0) I $G(KEYCHK)=1,'$D(^XUSEC("RCDPEAR",DUZ)) D Q ; PRCA*4.5*318 Added security key check "RTN","PRCAEXM",16,0) . W !!,"This action can only be taken by users that have the RCDPEAR security key.",! "RTN","PRCAEXM",17,0) . S VALMBCK="R" "RTN","PRCAEXM",18,0) . D PAUSE^VALM1 "RTN","PRCAEXM",19,0) RTRN ; line tag for GOTO return "RTN","PRCAEXM",20,0) D BEGIN^PRCAWO G:('$D(PRCABN))!('$D(PRCAEN)) END G:'$D(^PRCA(430,PRCABN,7)) END "RTN","PRCAEXM",21,0) L +^PRCA(430,PRCABN):1 I '$T W !!,*7,"ANOTHER USER IS EDITING THIS BILL" G RTRN "RTN","PRCAEXM",22,0) S PRCABN0=PRCABN "RTN","PRCAEXM",23,0) S PRCAIND=$G(^PRCA(430,PRCABN,7)) "RTN","PRCAEXM",24,0) S PRCAMT=$P(PRCAIND,U,2)+$P(PRCAIND,U,3)+$P(PRCAIND,U,4)+$P(PRCAIND,U,5) "RTN","PRCAEXM",25,0) S %=$P(^PRCA(430,PRCABN,0),U,2) I "PC"'[$P(^PRCA(430.2,%,0),U,6) W *7,!,"This AR may not be appropriate to charge Interest/Administrative cost.",!,"Please check the category of this AR.",! H 3 "RTN","PRCAEXM",26,0) K % W !!,"You may exempt the account from all the interest and administrative cost balances - making those balances zero (0),",!,"or adjust them." "RTN","PRCAEXM",27,0) EN011 S %=2 W !!,"Do you want to exempt the account from all the Int/Adm. costs" D YN^DICN I %<0 S PRCACOMM="User Cancelled" D DELETE^PRCAWO1 K PRCACOMM G RTRN "RTN","PRCAEXM",28,0) I %=1 D EN11,END G RTRN "RTN","PRCAEXM",29,0) I %=0 W !,"ANSWER 'YES' OR 'NO' " G EN011 "RTN","PRCAEXM",30,0) W !,"Adjusting the administrative/Interest charge ...",! "RTN","PRCAEXM",31,0) D DIEEN^PRCAWO1,END G RTRN "RTN","PRCAEXM",32,0) ; "RTN","PRCAEXM",33,0) ; exempt interest and admin charges "RTN","PRCAEXM",34,0) EN11 S PRCATYPE=14,DIE="^PRCA(433,",DA=PRCAEN "RTN","PRCAEXM",35,0) S DR=".03////^S X="_PRCABN_";11////^S X="_DT_";12////^S X="_PRCATYPE_";15////^S X="_PRCAMT_";" "RTN","PRCAEXM",36,0) S DR=DR_"27////^S X="_+$P(PRCAIND,U,2)_";" ;interest "RTN","PRCAEXM",37,0) S DR=DR_"28////^S X="_+$P(PRCAIND,U,3)_";" ;admin charge "RTN","PRCAEXM",38,0) S DR=DR_"25////^S X="_+$P(PRCAIND,U,4)_";" ;marshal fee "RTN","PRCAEXM",39,0) S DR=DR_"26////^S X="_+$P(PRCAIND,U,5)_";" ;court cost "RTN","PRCAEXM",40,0) S DIC=DIE,PRCA("LOCK")=0 D LOCKF^PRCAWO1 Q:PRCA("LOCK")=1 D ^DIE "RTN","PRCAEXM",41,0) I PRCAEN,$D(^PRCA(430,"TCSP",PRCABN)) D DECADJ^RCTCSPU(PRCABN,PRCAEN) ;prca*4.5*301 add cs 5B flag "RTN","PRCAEXM",42,0) S $P(^PRCA(430,PRCABN,7),U,2,5)="0^0^0^0" D TRANST^PRCAWO1 Q "RTN","PRCAEXM",43,0) ; "RTN","PRCAEXM",44,0) ; "RTN","PRCAEXM",45,0) EN2 Q:'$D(PRCAEN) Q:($P(^PRCA(433,PRCAEN,2),U,8)="")&($P(^PRCA(433,PRCAEN,2),U,7)="") "RTN","PRCAEXM",46,0) W !,"MONTHLY ADMIN. CHARGE: ",?25,+$P(^PRCA(433,PRCAEN,2),U,8),?40,"INTEREST CHARGE: ",+$P(^PRCA(433,PRCAEN,2),U,7) Q "RTN","PRCAEXM",47,0) ; "RTN","PRCAEXM",48,0) END L -^PRCA(433,+$G(PRCAEN)),-^PRCA(430,+$G(PRCABN)) "RTN","PRCAEXM",49,0) S X(1)=0,X=$G(^PRCA(430,+$G(PRCABN0),7)),X(1)=+X,X(1)=$P(X,"^",2)+X(1),X(1)=$P(X,"^",3)+X(1),X(1)=$P(X,"^",4)+X(1),X(1)=$P(X,"^",5)+X(1) "RTN","PRCAEXM",50,0) K PRCA("STATUS") "RTN","PRCAEXM",51,0) I X(1)=0,$G(PRCABN0) D "RTN","PRCAEXM",52,0) .;Check for payment transactions "RTN","PRCAEXM",53,0) .F X=0:0 S X=$O(^PRCA(433,"C",PRCABN0,X)) Q:'X I ",2,7,20,"[(","_$P($G(^PRCA(430.3,+$P($G(^PRCA(433,X,1)),"^",2),0)),"^",3)_",") S PRCA("STATUS")=$O(^PRCA(430.3,"AC",108,0)) "RTN","PRCAEXM",54,0) .S:'$D(PRCA("STATUS")) PRCA("STATUS")=$O(^PRCA(430.3,"AC",111,0)) "RTN","PRCAEXM",55,0) .S DA=PRCABN0,DIE="^PRCA(430,",DR="8////"_PRCA("STATUS") D ^DIE "RTN","PRCAEXM",56,0) K PRCATY,PRCA,PRCA2,PRCAD,PRCABN,PRCAEN,PRCATYPE,DA,DIE,DIC,PRCAMT,DR,X,% Q "RTN","PRCAEXM",57,0) ; "RTN","RCBEADJ1") 0^29^B18586021 "RTN","RCBEADJ1",1,0) RCBEADJ1 ;ALB/PJH - PENDING PAYMENTS ;24-FEB-03 "RTN","RCBEADJ1",2,0) ;;4.5;Accounts Receivable;**173,276,321,326,332**;Mar 20, 1995;Build 40 "RTN","RCBEADJ1",3,0) ;;Per VA Directive 6402, this routine should not be modified. "RTN","RCBEADJ1",4,0) Q "RTN","RCBEADJ1",5,0) WARN(RCBILLDA) ; Display warning if pending payments exist EP ^RCBEADJ "RTN","RCBEADJ1",6,0) ; Input - RCBILLDA - Pointer #430 - required "RTN","RCBEADJ1",7,0) ; Output - None - output to screen only "RTN","RCBEADJ1",8,0) ; "RTN","RCBEADJ1",9,0) ; Check for valid input "RTN","RCBEADJ1",10,0) Q:'$G(RCBILLDA) "RTN","RCBEADJ1",11,0) ; "RTN","RCBEADJ1",12,0) N DEBTOR,RCAMT,RCEOB,RCERA,RCLINE,RCPAID,RCPEND,RCRCPT,RCRCPTN,RCSUB,RCTOT,RCTRACE,RCTRANDA,RCZ,RCZL "RTN","RCBEADJ1",13,0) ; Set DEBTOR value "RTN","RCBEADJ1",14,0) S DEBTOR=RCBILLDA_";PRCA(430," "RTN","RCBEADJ1",15,0) ; Check for unprocessed receipts "RTN","RCBEADJ1",16,0) S RCPEND=$$PENDPAY^RCDPURET(DEBTOR) "RTN","RCBEADJ1",17,0) ; Extract receipt numbers and amounts paid on individual lines for pending receipts "RTN","RCBEADJ1",18,0) S RCRCPT=0 "RTN","RCBEADJ1",19,0) F S RCRCPT=$O(^TMP($J,"RCDPUREC","PP",RCRCPT)) Q:'RCRCPT D "RTN","RCBEADJ1",20,0) . S RCRCPTN=$$GET1^DIQ(344,RCRCPT_",",.01) Q:RCRCPTN="" "RTN","RCBEADJ1",21,0) . S RCPEND("R",RCRCPTN)=0 "RTN","RCBEADJ1",22,0) . S RCTRANDA=0 "RTN","RCBEADJ1",23,0) . F S RCTRANDA=$O(^TMP($J,"RCDPUREC","PP",RCRCPT,RCTRANDA)) Q:'RCTRANDA D "RTN","RCBEADJ1",24,0) . . S RCAMT=$P($G(^TMP($J,"RCDPUREC","PP",RCRCPT,RCTRANDA)),U,4) Q:+RCAMT=0 "RTN","RCBEADJ1",25,0) . . ; Save paid amount for this claim on this receipt "RTN","RCBEADJ1",26,0) . . S RCPEND("R",RCRCPTN)=RCPEND("R",RCRCPTN)+RCAMT "RTN","RCBEADJ1",27,0) . . ; Get trace number for ERA "RTN","RCBEADJ1",28,0) . . S RCERA=$$GET1^DIQ(344,RCRCPT_",",.18,"I") "RTN","RCBEADJ1",29,0) . . S RCTRACE=$S(RCERA:$$GET1^DIQ(344.4,RCERA_",",.02,"I"),1:"No Trace Number") "RTN","RCBEADJ1",30,0) . . ; Save trace number "RTN","RCBEADJ1",31,0) . . S RCPEND("R",RCRCPTN,"T")=RCTRACE "RTN","RCBEADJ1",32,0) ; Clear ^TMP array returned by $$PENDPAY "RTN","RCBEADJ1",33,0) K ^TMP($J,"RCDPUREC","PP") "RTN","RCBEADJ1",34,0) ; Find EEOB's for this claim "RTN","RCBEADJ1",35,0) S RCEOB=0 "RTN","RCBEADJ1",36,0) F S RCEOB=$O(^IBM(361.1,"B",RCBILLDA,RCEOB)) Q:'RCEOB D "RTN","RCBEADJ1",37,0) . ;Find ERAs for this EOB - may be multiple "RTN","RCBEADJ1",38,0) . S RCERA=0 "RTN","RCBEADJ1",39,0) . F S RCERA=$O(^RCY(344.4,"ADET",RCEOB,RCERA)) Q:'RCERA D "RTN","RCBEADJ1",40,0) . . ; Ignore ERA which already has a receipt - processed or otherwise "RTN","RCBEADJ1",41,0) . . I $$GET1^DIQ(344.4,RCERA_",",.08,"I") Q "RTN","RCBEADJ1",42,0) . . ; Get ERA lines for this EOB "RTN","RCBEADJ1",43,0) . . S RCLINE=0,RCTOT=0 "RTN","RCBEADJ1",44,0) . . F S RCLINE=$O(^RCY(344.4,"ADET",RCEOB,RCERA,RCLINE)) Q:'RCLINE D "RTN","RCBEADJ1",45,0) . . . ; Get paid amount from ERA line "RTN","RCBEADJ1",46,0) . . . S RCPAID=$$GET1^DIQ(344.41,RCLINE_","_RCERA_",",.03) "RTN","RCBEADJ1",47,0) . . . ; Ignore zero lines "RTN","RCBEADJ1",48,0) . . . Q:'RCPAID "RTN","RCBEADJ1",49,0) . . . ; If no scratchpad use paid amount from ERA - does not take into account ERA level adjustments "RTN","RCBEADJ1",50,0) . . . I '$D(^RCY(344.49,RCERA)) S RCTOT=RCTOT+RCPAID Q "RTN","RCBEADJ1",51,0) . . . ; Find ERA line in scratchpad "RTN","RCBEADJ1",52,0) . . . S RCZL=$$FIND(RCERA,RCLINE) Q:'RCZL "RTN","RCBEADJ1",53,0) . . . ; If scratchpad exists scan B index for split lines(344.49 is DINUM with 344.4) "RTN","RCBEADJ1",54,0) . . . S RCSUB=RCZL "RTN","RCBEADJ1",55,0) . . . F S RCSUB=$O(^RCY(344.49,RCERA,1,"B",RCSUB)) Q:(RCSUB\1)'=RCZL D "RTN","RCBEADJ1",56,0) . . . . S RCZ=$O(^RCY(344.49,RCERA,1,"B",RCSUB,"")) Q:'RCZ "RTN","RCBEADJ1",57,0) . . . . ; Check AR BILL is for this claim "RTN","RCBEADJ1",58,0) . . . . Q:$$GET1^DIQ(344.491,RCZ_","_RCERA_",",.07,"I")'=RCBILLDA "RTN","RCBEADJ1",59,0) . . . . ; Add AMOUNT TO POST ON RECEIPT to pending total - should resolve reversals "RTN","RCBEADJ1",60,0) . . . . S RCTOT=RCTOT+$$GET1^DIQ(344.491,RCZ_","_RCERA_",",.03) "RTN","RCBEADJ1",61,0) . . ; If claim total for the ERA is zero do not save trace number and paid amount "RTN","RCBEADJ1",62,0) . . Q:RCTOT=0 "RTN","RCBEADJ1",63,0) . . ; Otherwise get trace number "RTN","RCBEADJ1",64,0) . . S RCTRACE=$$GET1^DIQ(344.4,RCERA_",",.02,"I") "RTN","RCBEADJ1",65,0) . . S RCPEND=RCPEND+RCTOT "RTN","RCBEADJ1",66,0) . . ; Save totals by ERA "RTN","RCBEADJ1",67,0) . . S RCPEND("E",RCERA)=RCTOT,RCPEND("E",RCERA,"T")=$S(RCTRACE'="":RCTRACE,1:"No Trace Number") "RTN","RCBEADJ1",68,0) Q:'RCPEND "RTN","RCBEADJ1",69,0) W !!,"Warning - Pending Payments of $"_$J(RCPEND,0,2)_" exist." "RTN","RCBEADJ1",70,0) ; List unprocessed receipts "RTN","RCBEADJ1",71,0) S RCRCPTN="" "RTN","RCBEADJ1",72,0) F S RCRCPTN=$O(RCPEND("R",RCRCPTN)) Q:RCRCPTN="" W !,"Rcpt: ",RCRCPTN,?16,$J("$"_$J(RCPEND("R",RCRCPTN),0,2),11),?29,$G(RCPEND("R",RCRCPTN,"T")) "RTN","RCBEADJ1",73,0) ; List unprocessed EOB "RTN","RCBEADJ1",74,0) S RCERA="" "RTN","RCBEADJ1",75,0) F S RCERA=$O(RCPEND("E",RCERA)) Q:'RCERA W !,"ERA : ",RCERA,?16,$J("$"_$J(RCPEND("E",RCERA),0,2),11),?29,$G(RCPEND("E",RCERA,"T")) "RTN","RCBEADJ1",76,0) Q "RTN","RCBEADJ1",77,0) ; "RTN","RCBEADJ1",78,0) FIND(RCERA,RCLINE) ; Search ORIGINAL ERA SEQUENCES for this line "RTN","RCBEADJ1",79,0) ; Input RCERA - Scratchpad IEN "RTN","RCBEADJ1",80,0) ; RCLINE - ERA line to find "RTN","RCBEADJ1",81,0) ; Output RET - Scratchpad line number "RTN","RCBEADJ1",82,0) ; "RTN","RCBEADJ1",83,0) N DA,ORIG,RCSUB,RET "RTN","RCBEADJ1",84,0) S RCSUB=0,RET=0 "RTN","RCBEADJ1",85,0) F S RCSUB=$O(^RCY(344.49,RCERA,1,"ASEQ",RCSUB)) Q:RET Q:'RCSUB D "RTN","RCBEADJ1",86,0) . S DA=$O(^RCY(344.49,RCERA,1,"ASEQ",RCSUB,"")) Q:'DA "RTN","RCBEADJ1",87,0) . ;Get Original sequences "RTN","RCBEADJ1",88,0) . S ORIG=$$GET1^DIQ(344.491,DA_","_RCERA_",",.09) Q:ORIG="" "RTN","RCBEADJ1",89,0) . ;Check if scratchpad line is for original ERA line "RTN","RCBEADJ1",90,0) . S ORIG=","_ORIG_"," "RTN","RCBEADJ1",91,0) . S:$F(ORIG,","_RCLINE_",") RET=RCSUB "RTN","RCBEADJ1",92,0) Q RET "RTN","RCBEUTRA") 0^28^B30998596 "RTN","RCBEUTRA",1,0) RCBEUTRA ;WISC/RFJ-utilties for transactions (in file 433) ;1 Jun 00 "RTN","RCBEUTRA",2,0) ;;4.5;Accounts Receivable;**153,169,204,326,332**;Mar 20, 1995;Build 40 "RTN","RCBEUTRA",3,0) ;;Per VA Directive 6402, this routine should not be modified. "RTN","RCBEUTRA",4,0) Q "RTN","RCBEUTRA",5,0) ; "RTN","RCBEUTRA",6,0) ; "RTN","RCBEUTRA",7,0) ADD433(BILLDA,TRANTYPE) ; add a new transaction to file 433 (silent) "RTN","RCBEUTRA",8,0) ; return: ien of 433 transaction or 0^error msg "RTN","RCBEUTRA",9,0) ; : ^prca(433,ien) will be locked if entry selected "RTN","RCBEUTRA",10,0) ; Input - optional variable RCDUZ for the processed by user. SET in ^RCDPEAP from MARKED FOR AUTOPOST USER. PRCA*4.5*326 "RTN","RCBEUTRA",11,0) N %I,DA,DATA0,DD,DIC,DICR,DIE,DINUM,DIW,DLAYGO,DO,I,RCTRANDA,REFCODE,X,Y "RTN","RCBEUTRA",12,0) ; "RTN","RCBEUTRA",13,0) ; find next available transaction number "RTN","RCBEUTRA",14,0) ; add an extra level of locks, some operating systems do not process "RTN","RCBEUTRA",15,0) ; the locks correctly if they happen at the same time. "RTN","RCBEUTRA",16,0) L +^PRCA(433,"ADDNEWENTRY"):DILOCKTM "RTN","RCBEUTRA",17,0) I '$T Q "0^Another user is adding an AR Transaction, please try again later." "RTN","RCBEUTRA",18,0) ; start with last entry in file "RTN","RCBEUTRA",19,0) ; -> if no data is in the entry, lock it "RTN","RCBEUTRA",20,0) ; -> if the lock works and no data was added (prior to the lock) "RTN","RCBEUTRA",21,0) ; -> then you have the entry. "RTN","RCBEUTRA",22,0) ; -> otherwise, unlock it and start over "RTN","RCBEUTRA",23,0) F DINUM=$P(^PRCA(433,0),"^",3)+1:1 I '$D(^PRCA(433,DINUM)) L +^PRCA(433,DINUM):DILOCKTM Q:$T&('$D(^PRCA(433,DINUM))) L -^PRCA(433,DINUM) "RTN","RCBEUTRA",24,0) L -^PRCA(433,"ADDNEWENTRY") "RTN","RCBEUTRA",25,0) ; "RTN","RCBEUTRA",26,0) ; add entry to file "RTN","RCBEUTRA",27,0) S RCTRANDA=DINUM,(DIC,DIE)="^PRCA(433,",DIC(0)="L",DLAYGO=433,X=DINUM "RTN","RCBEUTRA",28,0) ; build DR string, 42=processed by (use postmaster if queued) "RTN","RCBEUTRA",29,0) S DIC("DR")="42////"_$S($G(RCDUZ):RCDUZ,$D(ZTQUEUED):.5,1:DUZ)_";" ; PRCA*4.5*326 Use RCDUZ if defined "RTN","RCBEUTRA",30,0) S DIC("DR")=DIC("DR")_".03////"_BILLDA_";" ;bill ien "RTN","RCBEUTRA",31,0) S DIC("DR")=DIC("DR")_"12////"_TRANTYPE_";" ;transaction type "RTN","RCBEUTRA",32,0) S DATA0=$G(^PRCA(430,BILLDA,0)) "RTN","RCBEUTRA",33,0) ; appropriation symbol "RTN","RCBEUTRA",34,0) I $P(DATA0,"^",18)'="" S DIC("DR")=DIC("DR")_"8////"_$P(DATA0,"^",18)_";" "RTN","RCBEUTRA",35,0) ; segment "RTN","RCBEUTRA",36,0) I $P(DATA0,"^",21)'="" S DIC("DR")=DIC("DR")_"6////"_$P(DATA0,"^",21)_";" "RTN","RCBEUTRA",37,0) ; test for referral code "RTN","RCBEUTRA",38,0) S REFCODE=$P($G(^PRCA(430,BILLDA,6)),"^",5) "RTN","RCBEUTRA",39,0) I REFCODE'="" S REFCODE=$S(REFCODE="DC":"RC",1:REFCODE),DIC("DR")=DIC("DR")_"7////"_REFCODE_";" "RTN","RCBEUTRA",40,0) ; file it "RTN","RCBEUTRA",41,0) D FILE^DICN "RTN","RCBEUTRA",42,0) I Y=-1 L -^PRCA(433,RCTRANDA) Q "0^UNABLE TO ADD A NEW ENTRY TO FILE 433" "RTN","RCBEUTRA",43,0) Q RCTRANDA "RTN","RCBEUTRA",44,0) ; "RTN","RCBEUTRA",45,0) ; "RTN","RCBEUTRA",46,0) FY433(RCTRANDA) ; transfer fiscal year multiple from 430 to 433 "RTN","RCBEUTRA",47,0) ; bill number must be stored in file 433, field .03 before calling "RTN","RCBEUTRA",48,0) N BILLDA,FY,FYDATA "RTN","RCBEUTRA",49,0) S BILLDA=+$P($G(^PRCA(433,RCTRANDA,0)),"^",2) I 'BILLDA Q "RTN","RCBEUTRA",50,0) K ^PRCA(433,RCTRANDA,4) "RTN","RCBEUTRA",51,0) S FY=0 F S FY=$O(^PRCA(430,BILLDA,2,FY)) Q:'FY D "RTN","RCBEUTRA",52,0) . S FYDATA=$G(^PRCA(430,BILLDA,2,FY,0)) I $P(FYDATA,"^")="" Q "RTN","RCBEUTRA",53,0) . S ^PRCA(433,RCTRANDA,4,FY,0)=$P(FYDATA,"^",1,3)_"^1" "RTN","RCBEUTRA",54,0) . S ^PRCA(433,RCTRANDA,4,"B",$P(FYDATA,"^"),FY)="" "RTN","RCBEUTRA",55,0) ; "RTN","RCBEUTRA",56,0) S ^PRCA(433,RCTRANDA,4,0)="^433.01I^"_$P($G(^PRCA(430,BILLDA,2,0)),"^",3,4) "RTN","RCBEUTRA",57,0) Q "RTN","RCBEUTRA",58,0) ; "RTN","RCBEUTRA",59,0) ; "RTN","RCBEUTRA",60,0) FYMULT(RCTRANDA) ; apply payment to fy multiple, oldest first "RTN","RCBEUTRA",61,0) N AMOUNT,FYDA,FYAMOUNT "RTN","RCBEUTRA",62,0) ; transfer fy multiple if not there "RTN","RCBEUTRA",63,0) I '$D(^PRCA(433,RCTRANDA,4)) D FY433(RCTRANDA) "RTN","RCBEUTRA",64,0) ; amount is principal amount "RTN","RCBEUTRA",65,0) S AMOUNT=$P($$TRANVALU^RCDPBTLM(RCTRANDA),"^",2) I 'AMOUNT Q "RTN","RCBEUTRA",66,0) ; "RTN","RCBEUTRA",67,0) ; the transaction value is minus, decrease principal "RTN","RCBEUTRA",68,0) I AMOUNT<0 D Q "RTN","RCBEUTRA",69,0) . S AMOUNT=-AMOUNT "RTN","RCBEUTRA",70,0) . S FYDA=0 F S FYDA=$O(^PRCA(433,RCTRANDA,4,FYDA)) Q:'FYDA D I 'AMOUNT Q "RTN","RCBEUTRA",71,0) . . S FYAMOUNT=$P($G(^PRCA(433,RCTRANDA,4,FYDA,0)),"^",2) "RTN","RCBEUTRA",72,0) . . ; fy amount is greater than transaction amount "RTN","RCBEUTRA",73,0) . . I FYAMOUNT>AMOUNT D Q "RTN","RCBEUTRA",74,0) . . . S $P(^PRCA(433,RCTRANDA,4,FYDA,0),"^",2)=FYAMOUNT-AMOUNT "RTN","RCBEUTRA",75,0) . . . S $P(^PRCA(433,RCTRANDA,4,FYDA,0),"^",5)=AMOUNT "RTN","RCBEUTRA",76,0) . . . S AMOUNT=0 "RTN","RCBEUTRA",77,0) . . ; fy amount not greater than total amount "RTN","RCBEUTRA",78,0) . . S $P(^PRCA(433,RCTRANDA,4,FYDA,0),"^",2)=0 "RTN","RCBEUTRA",79,0) . . S $P(^PRCA(433,RCTRANDA,4,FYDA,0),"^",5)=FYAMOUNT "RTN","RCBEUTRA",80,0) . . S AMOUNT=AMOUNT-FYAMOUNT "RTN","RCBEUTRA",81,0) . ; move back to 430 "RTN","RCBEUTRA",82,0) . D FYMULT^RCBEUBIL(RCTRANDA) "RTN","RCBEUTRA",83,0) ; "RTN","RCBEUTRA",84,0) ; the transaction value is plus, increase principal "RTN","RCBEUTRA",85,0) S FYDA=$O(^PRCA(433,RCTRANDA,4,999),-1) I 'FYDA Q "RTN","RCBEUTRA",86,0) S $P(^PRCA(433,RCTRANDA,4,FYDA,0),"^",2)=$P(^PRCA(433,RCTRANDA,4,FYDA,0),"^",2)+AMOUNT "RTN","RCBEUTRA",87,0) S $P(^PRCA(433,RCTRANDA,4,FYDA,0),"^",5)=AMOUNT "RTN","RCBEUTRA",88,0) ; move back to 430 "RTN","RCBEUTRA",89,0) D FYMULT^RCBEUBIL(RCTRANDA) "RTN","RCBEUTRA",90,0) Q "RTN","RCBEUTRA",91,0) ; "RTN","RCBEUTRA",92,0) ; "RTN","RCBEUTRA",93,0) EDIT433(RCTRANDA,DR) ; edit the field in 433 with the DR string passed "RTN","RCBEUTRA",94,0) I '$D(^PRCA(433,RCTRANDA)) Q "RTN","RCBEUTRA",95,0) N %,D,D0,D1,DA,DDH,DI,DIC,DIE,DQ,J,X,Y "RTN","RCBEUTRA",96,0) S (DIC,DIE)="^PRCA(433,",DA=RCTRANDA "RTN","RCBEUTRA",97,0) D ^DIE "RTN","RCBEUTRA",98,0) ; user pressed up-arrow "RTN","RCBEUTRA",99,0) I $D(Y) Q "0^TRANSACTION NOT COMPLETELY PROCESSED" "RTN","RCBEUTRA",100,0) Q 1 "RTN","RCBEUTRA",101,0) ; "RTN","RCBEUTRA",102,0) ; "RTN","RCBEUTRA",103,0) PROCESS(RCTRANDA) ; mark transaction as processed "RTN","RCBEUTRA",104,0) I '$D(^PRCA(433,RCTRANDA,0)) Q "RTN","RCBEUTRA",105,0) N D,D0,DA,DI,DIC,DIE,DQ,DR,X,Y "RTN","RCBEUTRA",106,0) S (DIC,DIE)="^PRCA(433,",DA=RCTRANDA "RTN","RCBEUTRA",107,0) S DR="3////0;4////2;" "RTN","RCBEUTRA",108,0) D ^DIE "RTN","RCBEUTRA",109,0) Q "RTN","RCBEUTRA",110,0) ; "RTN","RCBEUTRA",111,0) ; "RTN","RCBEUTRA",112,0) INCOMPLE(RCTRANDA) ; opposite of processed, make a transaction incomplete "RTN","RCBEUTRA",113,0) I '$D(^PRCA(433,RCTRANDA,0)) Q "RTN","RCBEUTRA",114,0) N D,D0,DA,DI,DIC,DIE,DQ,DR,X,Y "RTN","RCBEUTRA",115,0) S (DIC,DIE)="^PRCA(433,",DA=RCTRANDA "RTN","RCBEUTRA",116,0) S DR="4////1;" "RTN","RCBEUTRA",117,0) D ^DIE "RTN","RCBEUTRA",118,0) Q "RTN","RCBEUTRA",119,0) ; "RTN","RCBEUTRA",120,0) ; "RTN","RCBEUTRA",121,0) DEL433(RCTRANDA,COMMENT,ARCHIVE) ; delete (mark incomplete) in file 433 "RTN","RCBEUTRA",122,0) ; comment is the user comment in field 41 (default USER CANCELLED) "RTN","RCBEUTRA",123,0) ; archive is set to 1 if called to archive transaction "RTN","RCBEUTRA",124,0) I '$D(^PRCA(433,RCTRANDA,0)) Q "RTN","RCBEUTRA",125,0) N %,D,D0,DA,DI,DIC,DIE,DQ,DR,J,RCBILLDA,X,Y "RTN","RCBEUTRA",126,0) ; "RTN","RCBEUTRA",127,0) S (DIC,DIE)="^PRCA(433,",DA=RCTRANDA "RTN","RCBEUTRA",128,0) ; build DR string "RTN","RCBEUTRA",129,0) S DR="" "RTN","RCBEUTRA",130,0) S DR=DR_"4////1;" ;transaction status incomplete "RTN","RCBEUTRA",131,0) S DR=DR_"10////1;" ;incomplete transaction flag "RTN","RCBEUTRA",132,0) S DR=DR_"11///T;" ;transaction date "RTN","RCBEUTRA",133,0) I $G(COMMENT)="" S COMMENT="USER CANCELLED" "RTN","RCBEUTRA",134,0) S DR=DR_"41///"_COMMENT_";" "RTN","RCBEUTRA",135,0) ; brief comment "RTN","RCBEUTRA",136,0) S RCBILLDA=$P($G(^PRCA(433,RCTRANDA,0)),"^",2) "RTN","RCBEUTRA",137,0) S DR=DR_"5.02////SYSTEM "_$S($G(ARCHIVE):"ARCHIVED",1:"INACTIVATED")_$S(RCBILLDA:" (BILL "_$P($G(^PRCA(430,RCBILLDA,0)),"^")_")",1:"")_";" "RTN","RCBEUTRA",138,0) D ^DIE "RTN","RCBEUTRA",139,0) ; since the bill number (field .03) is required, it must be manually removed "RTN","RCBEUTRA",140,0) I RCBILLDA S $P(^PRCA(433,RCTRANDA,0),"^",2)="" K ^PRCA(433,"C",RCBILLDA,RCTRANDA) "RTN","RCBEUTRA",141,0) ; remove fy multiple "RTN","RCBEUTRA",142,0) K ^PRCA(433,RCTRANDA,4) "RTN","RCBEUTRA",143,0) Q "RTN","RCBEUTRA",144,0) ; "RTN","RCBEUTRA",145,0) ; "RTN","RCBEUTRA",146,0) ADDCOMM(RCTRANDA,COMMENT) ; automatically put a comment on a transaction "RTN","RCBEUTRA",147,0) ; comment in the array comment(1)=first line "RTN","RCBEUTRA",148,0) ; comment(2)=second line "RTN","RCBEUTRA",149,0) N CURRLINE,LINE "RTN","RCBEUTRA",150,0) ; get the last line "RTN","RCBEUTRA",151,0) S CURRLINE=$O(^PRCA(433,RCTRANDA,7,99999999),-1) "RTN","RCBEUTRA",152,0) ; if comment already on transaction, add a blank line and "RTN","RCBEUTRA",153,0) ; date time of new comment "RTN","RCBEUTRA",154,0) I CURRLINE D "RTN","RCBEUTRA",155,0) . S CURRLINE=CURRLINE+1,^PRCA(433,RCTRANDA,7,CURRLINE,0)=" " "RTN","RCBEUTRA",156,0) . S CURRLINE=CURRLINE+1,^PRCA(433,RCTRANDA,7,CURRLINE,0)="Comment added on: "_$$FMTE^XLFDT($$NOW^XLFDT) "RTN","RCBEUTRA",157,0) ; add new lines "RTN","RCBEUTRA",158,0) F LINE=1:1 Q:'$D(COMMENT(LINE)) S ^PRCA(433,RCTRANDA,7,CURRLINE+LINE,0)=COMMENT(LINE) "RTN","RCBEUTRA",159,0) ; set the 0th node "RTN","RCBEUTRA",160,0) S ^PRCA(433,RCTRANDA,7,0)="^^"_(CURRLINE+LINE-1)_"^"_(CURRLINE+LINE-1)_"^"_DT_"^" "RTN","RCBEUTRA",161,0) Q "RTN","RCBEUTRA",162,0) FMSDATE(X) ;Finds the next month & year and sets the date for transmission "RTN","RCBEUTRA",163,0) ;of the document to FMS. If DT is after EOAM and the document has not "RTN","RCBEUTRA",164,0) ;been previously transmitted, the date will be set to the first of the "RTN","RCBEUTRA",165,0) ;next month. If the DT is after the EOAM and the document is being "RTN","RCBEUTRA",166,0) ;re-transmitted, the the date of transmission will be DT. The flag REGEN "RTN","RCBEUTRA",167,0) ;is set in the source code if the document is being "RTN","RCBEUTRA",168,0) ;re-transmitted, thus will have a transmission date of DT. "RTN","RCBEUTRA",169,0) I $G(REFMS) G QUIT "RTN","RCBEUTRA",170,0) I DT>$$LDATE^RCRJR(DT) S X=$E($$FPS^RCAMFN01(X,1),1,5)_"01" "RTN","RCBEUTRA",171,0) QUIT Q X "RTN","RCDPAYER") 0^44^B25767365 "RTN","RCDPAYER",1,0) RCDPAYER ;ALB/PJH - TPJI Utility ;Jun 06, 2014@19:11:19 "RTN","RCDPAYER",2,0) ;;4.5;Accounts Receivable;**269,276,298,326,332**;Mar 20, 1995;Build 40 "RTN","RCDPAYER",3,0) ;Per VA Directive 6402, this routine should not be modified. "RTN","RCDPAYER",4,0) ; "RTN","RCDPAYER",5,0) ;Integration Agreement 5549 "RTN","RCDPAYER",6,0) ; "RTN","RCDPAYER",7,0) Q "RTN","RCDPAYER",8,0) ; "RTN","RCDPAYER",9,0) EN(IB3611) ;Called from IBJTTC "RTN","RCDPAYER",10,0) ; IB3611 = ien of EXPLANATION OF BENEFITS file (361.1) "RTN","RCDPAYER",11,0) ; gathers payer contact data from file 361.1 and 344.4 "RTN","RCDPAYER",12,0) ; returns the data to IBJTTC for display on COMMENT HISTORY screen of TPJI "RTN","RCDPAYER",13,0) N AR3444,CONTACTS,ERA3,FOUND,I,IBTEXT,IB25,STR,WEB,NAME "RTN","RCDPAYER",14,0) ; "RTN","RCDPAYER",15,0) S CONTACTS="",STR="",FOUND=0,WEB="",NAME="" "RTN","RCDPAYER",16,0) ; "RTN","RCDPAYER",17,0) ;Retrieve contacts from EOB file "RTN","RCDPAYER",18,0) S IB25=$P($G(^IBM(361.1,IB3611,25)),U,1,7) ;IA 4051 "RTN","RCDPAYER",19,0) S:$TR(IB25,U,"")]"" FOUND=1,STR=IB25 "RTN","RCDPAYER",20,0) ; "RTN","RCDPAYER",21,0) ;Get ERA reference "RTN","RCDPAYER",22,0) S AR3444=$O(^RCY(344.4,"ADET",IB3611,"")) "RTN","RCDPAYER",23,0) ; "RTN","RCDPAYER",24,0) ;If no contact in EOB retrieve contacts from ERA file "RTN","RCDPAYER",25,0) I AR3444,'FOUND D "RTN","RCDPAYER",26,0) .S ERA3=$P($G(^RCY(344.4,AR3444,3)),U,1,7) "RTN","RCDPAYER",27,0) .S:$TR(ERA3,U,"")]"" FOUND=1,STR=ERA3 "RTN","RCDPAYER",28,0) ; "RTN","RCDPAYER",29,0) ;Retrieve Payer Web Address from ERA file "RTN","RCDPAYER",30,0) I AR3444 S WEB=$P($G(^RCY(344.4,AR3444,5)),U) S:WEB]"" FOUND=1 "RTN","RCDPAYER",31,0) ; "RTN","RCDPAYER",32,0) ;Get Payer Contact Name "RTN","RCDPAYER",33,0) S NAME=$P(STR,U) S:NAME]"" FOUND=1 "RTN","RCDPAYER",34,0) ; "RTN","RCDPAYER",35,0) ;Format contacts "RTN","RCDPAYER",36,0) I STR]"" D "RTN","RCDPAYER",37,0) .N I,CTYP,CPOS "RTN","RCDPAYER",38,0) .F I=2,4,6 D:$P(STR,U,I)]"" "RTN","RCDPAYER",39,0) ..;Validate contact type "RTN","RCDPAYER",40,0) ..S CTYP=$P(STR,U,I+1) "RTN","RCDPAYER",41,0) ..S CPOS=$S(CTYP="TE":1,CTYP="FX":2,CTYP="EM":3,CTYP="EX":4,1:0) "RTN","RCDPAYER",42,0) ..Q:'CPOS "RTN","RCDPAYER",43,0) ..;Save only first occurance of each type of contact "RTN","RCDPAYER",44,0) ..S:$P(CONTACTS,U,CPOS)="" $P(CONTACTS,U,CPOS)=$P(STR,U,I) "RTN","RCDPAYER",45,0) ; "RTN","RCDPAYER",46,0) ;Allow for misfiled legacy contact data "RTN","RCDPAYER",47,0) I FOUND,NAME="",WEB="",CONTACTS="" S FOUND=0 "RTN","RCDPAYER",48,0) ;Return found_web_phone_fax_email "RTN","RCDPAYER",49,0) Q FOUND_U_NAME_U_WEB_U_CONTACTS "RTN","RCDPAYER",50,0) ; "RTN","RCDPAYER",51,0) ADD(PRCABN) ;Update AR Transaction file #433 with comment type transaction "RTN","RCDPAYER",52,0) ;PRCABN = Bill/Claim IEN for file #399. "RTN","RCDPAYER",53,0) ;called only if 'ERA Contact Information' type comment is not found "RTN","RCDPAYER",54,0) ;serves as a notice to the user that the contact data came from the 835 ERA. Called from IBJTTC "RTN","RCDPAYER",55,0) ; "RTN","RCDPAYER",56,0) ;Note; PJH 8/11/2010 - see ADJUST^RCJIBFN3 (called by ARCA^IBJTA1) "RTN","RCDPAYER",57,0) ; "RTN","RCDPAYER",58,0) N AUTHDT,IBIFN,MRADT,STATUS "RTN","RCDPAYER",59,0) S IBIFN=PRCABN "RTN","RCDPAYER",60,0) S STATUS=$P($G(^DGCR(399,IBIFN,0)),U,13) "RTN","RCDPAYER",61,0) S AUTHDT=$P($G(^DGCR(399,IBIFN,"S")),U,10) "RTN","RCDPAYER",62,0) S MRADT=$P($G(^DGCR(399,IBIFN,"S")),U,7) "RTN","RCDPAYER",63,0) ; "RTN","RCDPAYER",64,0) ;If claim status is "NOT REVIEWED" or claim status is "CANCELLED" "RTN","RCDPAYER",65,0) ;with neither MRA request date nor Authorization date present "RTN","RCDPAYER",66,0) ;comment may not be added "RTN","RCDPAYER",67,0) I STATUS=1!(STATUS=7&(MRADT="")&(AUTHDT="")) Q "RTN","RCDPAYER",68,0) ; "RTN","RCDPAYER",69,0) ;If claim status is "REQUEST MRA" or claim status is "CANCELLED" "RTN","RCDPAYER",70,0) ;with MRA request date present, but no Authorization date comment "RTN","RCDPAYER",71,0) ;cannot be added "RTN","RCDPAYER",72,0) I STATUS=2!(STATUS=7&(MRADT'="")&(AUTHDT="")) Q "RTN","RCDPAYER",73,0) ; "RTN","RCDPAYER",74,0) ;Ignore bill cancelled in IB "RTN","RCDPAYER",75,0) I '$D(^PRCA(430,PRCABN,2,0)) Q "RTN","RCDPAYER",76,0) ; "RTN","RCDPAYER",77,0) ;Ignore Archived bill "RTN","RCDPAYER",78,0) I $P($G(^PRCA(430,PRCABN,0)),"^",8)=49 Q "RTN","RCDPAYER",79,0) ; "RTN","RCDPAYER",80,0) ;Build AR Transaction "RTN","RCDPAYER",81,0) ; "RTN","RCDPAYER",82,0) N PRCAEN,PRCAA1,DR,DIE,DA,D0,PRCAD,RCASK,PRCAA2,PRCA,PRCATY "RTN","RCDPAYER",83,0) ; "RTN","RCDPAYER",84,0) ;Create stub record in 433 "RTN","RCDPAYER",85,0) D SETTR^PRCAUTL,PATTR^PRCAUTL Q:'$D(PRCAEN) "RTN","RCDPAYER",86,0) ; "RTN","RCDPAYER",87,0) S PRCAA1=$S($D(^PRCA(433,PRCAEN,4,0)):+$P(^(0),U,4),1:0) "RTN","RCDPAYER",88,0) Q:PRCAA1'>0 S PRCAA2=$P(^(0),U,3) "RTN","RCDPAYER",89,0) ; "RTN","RCDPAYER",90,0) ;Direct update of [PRCA COMMENT] edit template fields "RTN","RCDPAYER",91,0) ;(excluding Date of Contact, Extended Comments and Follow-up Date) "RTN","RCDPAYER",92,0) S DIE="^PRCA(433,",DA=PRCAEN "RTN","RCDPAYER",93,0) S DR=".03////"_PRCABN ;Bill Number "RTN","RCDPAYER",94,0) S DR=DR_";3////0" ;Calm Code Done "RTN","RCDPAYER",95,0) S DR=DR_";12////"_$O(^PRCA(430.3,"AC",17,0)) ;Transaction Type "RTN","RCDPAYER",96,0) S DR=DR_";15////0" ;Transaction Amount "RTN","RCDPAYER",97,0) S DR=DR_";42////.5" ;Processed by POSTMASTER "RTN","RCDPAYER",98,0) S DR=DR_";11////"_DT ;Transaction date "RTN","RCDPAYER",99,0) S DR=DR_";4////2" ;Transaction status (complete) "RTN","RCDPAYER",100,0) S DR=DR_";5.02////ERA Payer Contact Information" D ^DIE "RTN","RCDPAYER",101,0) ; "RTN","RCDPAYER",102,0) ;Leave validation checks in place "RTN","RCDPAYER",103,0) I $P($G(^PRCA(433,PRCAEN,5)),"^",2)=""!'$P(^PRCA(433,PRCAEN,1),"^") S PRCACOMM="TRANSACTION INCOMPLETE" D DELETE^PRCAWO1 K PRCACOMM Q "RTN","RCDPAYER",104,0) ; "RTN","RCDPAYER",105,0) I '$D(PRCAD("DELETE")) S RCASK=1 D TRANUP^PRCAUTL,UPPRIN^PRCADJ "RTN","RCDPAYER",106,0) ; "RTN","RCDPAYER",107,0) I $P($G(^RCD(340,+$P(^PRCA(430,PRCABN,0),"^",9),0)),"^")[";DPT(" D "RTN","RCDPAYER",108,0) .;Ensure comment does not appear on patient statement "RTN","RCDPAYER",109,0) .S $P(^PRCA(433,PRCAEN,0),"^",10)=1 "RTN","RCDPAYER",110,0) Q "RTN","RCDPAYER",111,0) ; "RTN","RCDPAYER",112,0) ;Audit Comment from EOB Move/Copy "RTN","RCDPAYER",113,0) AUDIT(ORIG,TEXT,MODE) ; "RTN","RCDPAYER",114,0) ; ORIG = ien of entry in 361.1 "RTN","RCDPAYER",115,0) ; TEXT = move/copy reason "RTN","RCDPAYER",116,0) ; MODE = is this a move or a copy event "RTN","RCDPAYER",117,0) ; "RTN","RCDPAYER",118,0) ;Translate EOB ien to claim number IA 4051 "RTN","RCDPAYER",119,0) N PRCABN "RTN","RCDPAYER",120,0) S PRCABN=$P($G(^IBM(361.1,ORIG,0)),U) Q:'PRCABN "RTN","RCDPAYER",121,0) ;Build AR Transaction "RTN","RCDPAYER",122,0) ; "RTN","RCDPAYER",123,0) N PRCAEN,PRCAA1,DR,DIE,DA,D0,PRCAD,RCASK,PRCAA2,PRCA,PRCATY "RTN","RCDPAYER",124,0) ; "RTN","RCDPAYER",125,0) ;Create stub record in 433 "RTN","RCDPAYER",126,0) D SETTR^PRCAUTL,PATTR^PRCAUTL Q:'$D(PRCAEN) "RTN","RCDPAYER",127,0) ; "RTN","RCDPAYER",128,0) S PRCAA1=$S($D(^PRCA(433,PRCAEN,4,0)):+$P(^(0),U,4),1:0) "RTN","RCDPAYER",129,0) Q:PRCAA1'>0 S PRCAA2=$P(^(0),U,3) "RTN","RCDPAYER",130,0) ; "RTN","RCDPAYER",131,0) N MTEXT,INIT "RTN","RCDPAYER",132,0) S INIT=$$GET1^DIQ(200,DUZ,1) "RTN","RCDPAYER",133,0) S:INIT="" INIT="USER UNK." "RTN","RCDPAYER",134,0) S MTEXT="EEOB MOVED BY "_INIT "RTN","RCDPAYER",135,0) I MODE="C" S MTEXT="EEOB COPIED BY "_INIT "RTN","RCDPAYER",136,0) I MODE="R" S MTEXT="EEOB REMOVED BY "_INIT "RTN","RCDPAYER",137,0) I MODE="W" S MTEXT="EEOB MOVE/COPY IN SPLIT/EDIT" "RTN","RCDPAYER",138,0) I MODE="L" S MTEXT="EEOB MOVE/COPY IN LINK PAYMENT" "RTN","RCDPAYER",139,0) ;Direct update of [PRCA COMMENT] edit template fields "RTN","RCDPAYER",140,0) ;(excluding Date of Contact, Extended Comments and Follow-up Date) "RTN","RCDPAYER",141,0) S DIE="^PRCA(433,",DA=PRCAEN "RTN","RCDPAYER",142,0) S DR=".03////"_PRCABN ;Bill Number "RTN","RCDPAYER",143,0) S DR=DR_";3////0" ;Calm Code Done "RTN","RCDPAYER",144,0) S DR=DR_";12////"_$O(^PRCA(430.3,"AC",17,0)) ;Transaction Type "RTN","RCDPAYER",145,0) S DR=DR_";15////0" ;Transaction Amount "RTN","RCDPAYER",146,0) S DR=DR_";42////"_$S($G(RCDUZ):RCDUZ,1:DUZ) ;Processed by - PRCA*4.5*326 use RCDUZ if it is set "RTN","RCDPAYER",147,0) S DR=DR_";4////2" ;Transaction status (complete) "RTN","RCDPAYER",148,0) S DR=DR_";5.02////"_MTEXT ;Brief comment "RTN","RCDPAYER",149,0) D ^DIE "RTN","RCDPAYER",150,0) ;Store justification text in comment field "RTN","RCDPAYER",151,0) N DA,DIC,DLAYGO,DR,X "RTN","RCDPAYER",152,0) S DA(1)=PRCAEN "RTN","RCDPAYER",153,0) S DIC="^PRCA(433,"_DA(1)_",7,",DIC(0)="L",X=$P(TEXT,U) "RTN","RCDPAYER",154,0) D FILE^DICN "RTN","RCDPAYER",155,0) ;Store auto generated text from stand alone option in comment field "RTN","RCDPAYER",156,0) I $P(TEXT,U,2)]"" D "RTN","RCDPAYER",157,0) .N DA,DIC,DLAYGO,DR,X "RTN","RCDPAYER",158,0) .S DA(1)=PRCAEN "RTN","RCDPAYER",159,0) .S DIC="^PRCA(433,"_DA(1)_",7,",DIC(0)="L",X="- "_$P(TEXT,U,2) "RTN","RCDPAYER",160,0) .D FILE^DICN "RTN","RCDPAYER",161,0) Q "RTN","RCDPEAA2") 0^45^B160927525 "RTN","RCDPEAA2",1,0) RCDPEAA2 ;ALB/KML - APAR Screen - SELECTED EOB ;Jun 06, 2014@19:11:19 "RTN","RCDPEAA2",2,0) ;;4.5;Accounts Receivable;**298,304,318,321,326,332**;Mar 20, 1995;Build 40 "RTN","RCDPEAA2",3,0) ;Per VA Directive 6402, this routine should not be modified. "RTN","RCDPEAA2",4,0) Q "RTN","RCDPEAA2",5,0) ; "RTN","RCDPEAA2",6,0) INIT(RCIENS) ; Entry point for List template to build the display of the EEOB on APAR "RTN","RCDPEAA2",7,0) ; "RTN","RCDPEAA2",8,0) ; Input - RCIENS = ien of entry in file 344.49^ien of 344.491^selectable line item from listman screen "RTN","RCDPEAA2",9,0) ; "RTN","RCDPEAA2",10,0) N FDTTM "RTN","RCDPEAA2",11,0) D CLEAN^VALM10 "RTN","RCDPEAA2",12,0) K ^TMP("RCDPE-EOB_WL",$J),^TMP("RCDPE-EOB_WLDX",$J),^TMP("RCS",$J) "RTN","RCDPEAA2",13,0) S VALMCNT=0,VALMBG=1 "RTN","RCDPEAA2",14,0) D BLD(RCIENS) "RTN","RCDPEAA2",15,0) Q "RTN","RCDPEAA2",16,0) ; "RTN","RCDPEAA2",17,0) ; "RTN","RCDPEAA2",18,0) BLD(RCIENS) ; Display selected EEOB on APAR screen "RTN","RCDPEAA2",19,0) N RCZ0,RCZ41,RCERA,RCECME,REASON,V1,RCLI1,TLINE,RCSCR,Z,ZZ,Z0,ZZ1,RC0,RCTL,RCTS,RCCL,RCCL1 ; PRCA*4.5*332 "RTN","RCDPEAA2",20,0) S RCSCR=$P(RCIENS,U),Z=$P(^RCY(344.49,RCSCR,1,$P(RCIENS,U,2),0),U),RCPROG="RCDPEAA2" "RTN","RCDPEAA2",21,0) I Z#1=0 S ZZ=+$O(^RCY(344.49,RCSCR,1,"B",Z,0)) I ZZ D "RTN","RCDPEAA2",22,0) . S Z0=Z F S Z0=$O(^RCY(344.49,RCSCR,1,"B",Z0)) Q:((Z0\1)'=(Z\1)) S Z=Z0,ZZ1=+$O(^RCY(344.49,RCSCR,1,"B",Z0,0)) I ZZ1 D "RTN","RCDPEAA2",23,0) .. S ^TMP("RCS",$J,ZZ,ZZ1)="" "RTN","RCDPEAA2",24,0) . S ^TMP("RCS",$J,ZZ)="" "RTN","RCDPEAA2",25,0) S (RCTS,ZZ)=0 "RTN","RCDPEAA2",26,0) F S ZZ=$O(^TMP("RCS",$J,ZZ)) Q:'ZZ D "RTN","RCDPEAA2",27,0) . S RCZ0=$G(^RCY(344.49,RCSCR,1,ZZ,0)) "RTN","RCDPEAA2",28,0) . S RCECME=$P($G(^RCY(344.4,RCSCR,1,+$P(RCZ0,U,9),4)),U,2) ; ECME # (344.41,.24) "RTN","RCDPEAA2",29,0) . S REASON=$$GET1^DIQ(344.41,$P(RCZ0,U,9)_","_RCSCR_",",5) ; AUTOPOST REJECTION REASON (344.41,5) "RTN","RCDPEAA2",30,0) . S TLINE=$$TOPLINE(RCZ0) "RTN","RCDPEAA2",31,0) . D SET(TLINE,$P(RCZ0,U),$P(RCZ0,U),ZZ) "RTN","RCDPEAA2",32,0) . ; PRCA*4.5*304 - Add claim comment to screen if it exists for this ERA EEOB detail line "RTN","RCDPEAA2",33,0) . S:$P(RCZ0,U,9)'="" RCCL=$$GET1^DIQ(344.41,$P(RCZ0,U,9)_","_RCSCR_",",4) "RTN","RCDPEAA2",34,0) . D:$G(RCCL)'="" ; If we have a ERA Detail line comment, display it "RTN","RCDPEAA2",35,0) . . D SLINE(RCCL,"RCCL1",58,76) "RTN","RCDPEAA2",36,0) . . S TLINE=$J("",4)_"Claim Comment: "_RCCL1(1) "RTN","RCDPEAA2",37,0) . . D SET(TLINE,$P(RCZ0,U),$P(RCZ0,U),ZZ) "RTN","RCDPEAA2",38,0) . . ; If we have a second line for the comment then put it on the screen "RTN","RCDPEAA2",39,0) . . I RCCL1>1 D SET($J("",4)_RCCL1(2),$P(RCZ0,U),$P(RCZ0,U),ZZ) I RCCL1=3 D SET($J("",4)_RCCL1(3),$P(RCZ0,U),$P(RCZ0,U),ZZ) "RTN","RCDPEAA2",40,0) . ; **End of *304 modifications** "RTN","RCDPEAA2",41,0) . ; sub-line info (e.g., "n.001") "RTN","RCDPEAA2",42,0) . S ZZ1=0 F S ZZ1=$O(^TMP("RCS",$J,ZZ,ZZ1)) Q:'ZZ1 D "RTN","RCDPEAA2",43,0) . . S RCZZ0=$G(^RCY(344.49,RCSCR,1,ZZ1,0)) "RTN","RCDPEAA2",44,0) . . S RCT=$P(RCZZ0,U),RCTL=$L(RCT) "RTN","RCDPEAA2",45,0) . . S RCERA=+$G(^RCY(344.49,RCSCR,0)) ; PRCA*4.5*332 "RTN","RCDPEAA2",46,0) . . S RCZ41=$$IEN41(RCERA,RCT) ; PRCA*4.5*332 "RTN","RCDPEAA2",47,0) . . S V1=$S($P(RCZZ0,U,2)'["**ADJ":"",$P($P(RCZZ0,U,2),"ADJ",2):"***ADJUSTMENT AT ERA LEVEL",1:"*** ADJUSTMENT LINE FOR TOTALS MISMATCH") "RTN","RCDPEAA2",48,0) . . S RCLI1=$S(V1="":" Claim #: "_$P(RCZZ0,U,2)_" Patient/Last 4: "_$S($P(RCZZ0,U,7):$$PNM4("","",$P(RCZZ0,U,7)),'$P($G(^RCY(344.49,RCSCR,1,ZZ1,2)),U,3):$$PNM4(RCERA,RCZ41),1:"??"),1:V1) ; PRCA*4.5*332 "RTN","RCDPEAA2",49,0) . . D SET($J("",4)_$P(" ^(V)",U,$P(RCZZ0,U,13)+1)_RCT_RCLI1,RCT,RCT,ZZ1) "RTN","RCDPEAA2",50,0) . . I $P(RCZZ0,U,7) D CLINES(RCZZ0,RCT,ZZ1) "RTN","RCDPEAA2",51,0) . . ; "RTN","RCDPEAA2",52,0) . . D SET($J("",4+RCTL)_"Payment Amt: "_$J(+$P(RCZZ0,U,5),"",2)_" Total Adjustments: "_$J(+$P(RCZZ0,U,8),"",2)_" Net: "_$J($P(RCZZ0,U,5)+$P(RCZZ0,U,8),"",2),RCT,RCT,ZZ1) "RTN","RCDPEAA2",53,0) . . ; display pharmacy EEOB data "RTN","RCDPEAA2",54,0) . . I RCECME]"" D RXLINES(RCZZ0,RCECME,RCT,ZZ1) "RTN","RCDPEAA2",55,0) . . ; PRCA*4.5*321 BEGIN "RTN","RCDPEAA2",56,0) . . I $P(RCZZ0,U,10)'="" D "RTN","RCDPEAA2",57,0) . . . D SET($J("",9)_"Receipt Comment: "_$P(RCZZ0,U,10),$P(RCZZ0,U),RCT,ZZ1) "RTN","RCDPEAA2",58,0) . . . D SET($J("",9)_"Added By User: "_$$GET1^DIQ(344.491,ZZ1_","_RCSCR_",",2.03),RCTS,RCT,ZZ1) "RTN","RCDPEAA2",59,0) . . . D SET($J("",9)_"Date/Time Added: "_$$GET1^DIQ(344.491,ZZ1_","_RCSCR_",",2.04),RCTS,RCT,ZZ1) "RTN","RCDPEAA2",60,0) . . ; PRCA*4.5*321 END "RTN","RCDPEAA2",61,0) . . I $O(^RCY(344.49,RCSCR,1,ZZ1,1,0)) D ADJLINES(RCZZ0,RCT,ZZ1) "RTN","RCDPEAA2",62,0) . . I $G(^TMP($J,"RC_REVIEW")) D REVLINES(RCSCR,RCZZ0,RCT,ZZ1) "RTN","RCDPEAA2",63,0) . . D SET($J("",7)_"APAR Reason: "_REASON,RCT,RCT,ZZ1) "RTN","RCDPEAA2",64,0) . . S A="",$P(A,".",79)="" D SET(A,RCT,RCT,ZZ1) "RTN","RCDPEAA2",65,0) I VALMCNT=0 D SET("THERE ARE NO EEOBs MATCHING YOUR SELECTION CRITERIA") "RTN","RCDPEAA2",66,0) K ^TMP($J,"RCS") "RTN","RCDPEAA2",67,0) Q "RTN","RCDPEAA2",68,0) ; "RTN","RCDPEAA2",69,0) SET(X,RCSEQ,RCSEQ1,RCZ9) ; -- set ListManager arrays "RTN","RCDPEAA2",70,0) ; X = the data to set into the global "RTN","RCDPEAA2",71,0) ; RCSEQ = the selectable line # "RTN","RCDPEAA2",72,0) ; RCSEQ1 = = the sub line # "RTN","RCDPEAA2",73,0) ; RCZ9 = reference to the line(s) in file 344.41 or to the subline in "RTN","RCDPEAA2",74,0) ; file 344.49 for RCSEQ having a decimal "RTN","RCDPEAA2",75,0) S VALMCNT=VALMCNT+1,^TMP("RCDPE-EOB_WL",$J,VALMCNT,0)=X "RTN","RCDPEAA2",76,0) I $G(RCSEQ) S ^TMP("RCDPE-EOB_WL",$J,"IDX",VALMCNT,RCSEQ)="" "RTN","RCDPEAA2",77,0) I $G(RCSEQ1),'$D(^TMP("RCDPE-EOB_WLDX",$J,RCSEQ1)) S ^TMP("RCDPE-EOB_WLDX",$J,RCSEQ1)=VALMCNT_U_$G(RCZ9) "RTN","RCDPEAA2",78,0) Q "RTN","RCDPEAA2",79,0) ; "RTN","RCDPEAA2",80,0) TOPLINE(RCZ0) ; Function returns the top line of the EEOB display "RTN","RCDPEAA2",81,0) ; RCZ0 = the 0-node of the whole number entry line for the EEOB "RTN","RCDPEAA2",82,0) N A "RTN","RCDPEAA2",83,0) S A=" "_$S($P(RCZ0,U,13):"(V)",1:" ")_"EEOB: ERA Seq #"_$S($P(RCZ0,U,9)[",":"'s",1:"")_" "_$S($P(RCZ0,U,9)'="":$P(RCZ0,U,9),1:"None")_" Net Payment Amt: "_$J(+$P(RCZ0,U,6),"",2) "RTN","RCDPEAA2",84,0) I $G(^TMP($J,"RC_REVIEW")) S A=A_" Reviewed?: "_$S($P(RCZ0,U,11)="":"NO",1:$$EXTERNAL^DILFD(344.491,.11,,$P(RCZ0,U,11))) "RTN","RCDPEAA2",85,0) Q A "RTN","RCDPEAA2",86,0) ; "RTN","RCDPEAA2",87,0) ;PRCA*4.5*304 - Split long line into printable lengths "RTN","RCDPEAA2",88,0) SLINE(ZIN,ZARR,FLN,SLN) ; "RTN","RCDPEAA2",89,0) ; ZIN - Input string; ZARR - Array output of lines ; FLN - First line length ; SLN - Subsequent line lengths "RTN","RCDPEAA2",90,0) ; Assumes ZIN max length is 132 characters and FLN and SLN variables will make ZIN fit in 3 lines. "RTN","RCDPEAA2",91,0) N ZL,ZI,ZM "RTN","RCDPEAA2",92,0) I $L(ZIN)<(FLN+1) S @ZARR@(1)=ZIN,@ZARR=1 Q "RTN","RCDPEAA2",93,0) ; Otherwise we are spanning more than 1 line "RTN","RCDPEAA2",94,0) S ZL="" F ZI=1:1 Q:($L(ZL)+$L($P(ZIN," ",ZI)))>FLN S ZL=ZL_$S($L(ZL)>0:" ",1:"")_$P(ZIN," ",ZI) "RTN","RCDPEAA2",95,0) S @ZARR@(1)=ZL,ZL=$P(ZIN," ",ZI,9999) "RTN","RCDPEAA2",96,0) I $L(ZL)<(SLN+1) S @ZARR@(2)=ZL,@ZARR=2 Q "RTN","RCDPEAA2",97,0) ; Spilling onto a third line. "RTN","RCDPEAA2",98,0) S ZM="" F ZI=1:1 Q:($L(ZM)+$L($P(ZL," ",ZI)))>SLN S ZM=ZM_$S($L(ZM)>0:" ",1:"")_$P(ZL," ",ZI) "RTN","RCDPEAA2",99,0) S @ZARR@(2)=ZM,ZM=$P(ZL," ",ZI,9999) "RTN","RCDPEAA2",100,0) S @ZARR@(3)=ZM,@ZARR=3 "RTN","RCDPEAA2",101,0) Q "RTN","RCDPEAA2",102,0) ; **END of *304 changes** "RTN","RCDPEAA2",103,0) ; "RTN","RCDPEAA2",104,0) CLINES(RCZZ0,RCT,ZZ1) ; called from BLD ; set up the claim information lines "RTN","RCDPEAA2",105,0) ; "RTN","RCDPEAA2",106,0) ; Input - RCZZ0 = zero node data at 344.491 "RTN","RCDPEAA2",107,0) ; RCT = sub line # "RTN","RCDPEAA2",108,0) ; ZZ1 = reference to the to the subline in "RTN","RCDPEAA2",109,0) ; file 344.49 for RCSEQ having a decimal "RTN","RCDPEAA2",110,0) N A,RCX,Q,QQ "RTN","RCDPEAA2",111,0) S A("OA")=$$ORI^PRCAFN(+$P(RCZZ0,U,7)),A("SDT")=$P($G(^DGCR(399,+$P(RCZZ0,U,7),"U")),U),A("DFN")=+$P($G(^(0)),U,2),A("ENRPR")="" "RTN","RCDPEAA2",112,0) ; Find Rx copay status "RTN","RCDPEAA2",113,0) S A("RXCP")=$S('A("SDT"):"",1:$$RXST^IBARXEU(A("DFN"),A("SDT"))),A("RXCP")=$S($P(A("RXCP"),U)'="":$P(A("RXCP"),U,2),1:"UNKNOWN") ;IA #10147 "RTN","RCDPEAA2",114,0) ; Find M/T status "RTN","RCDPEAA2",115,0) S RCX=$$LST^DGMTU(A("DFN"),A("SDT")),A("M/T")=$P(RCX,U,4) "RTN","RCDPEAA2",116,0) S A("M/T")=$S('RCX:"??",A("M/T")="P":"PEN",A("M/T")="C":"YES",A("M/T")="G":"GMT",A("M/T")="R":"REQ",1:"NO") "RTN","RCDPEAA2",117,0) S QQ=" Billed Amt: "_$J(A("OA"),"",2)_" Amt To Post: "_$J(+$P(RCZZ0,U,3),"",2) "RTN","RCDPEAA2",118,0) D SET($J("",4+RCTL)_"Claim Bal: "_$J(+$P($$BILL^RCJIBFN2(+$P(RCZZ0,U,7)),U,3),"",2)_QQ,$P(RCZZ0,U),RCT,ZZ1) "RTN","RCDPEAA2",119,0) S ^TMP("RC_BILL",$J,$P(RCZZ0,U,7),RCT)=QQ "RTN","RCDPEAA2",120,0) S Z3=$J("",4+RCTL)_"Svc Dt: "_$S(A("SDT")'="":$$FMTE^XLFDT(A("SDT"),2),1:"UNKNOWN") "RTN","RCDPEAA2",121,0) S Z3=Z3_" COB: "_$S($D(^DGCR(399,+$P(RCZZ0,U,7),"I"_($$COBN(+$P(RCZZ0,U,7))+1))):"YES",1:"NO ") "RTN","RCDPEAA2",122,0) D SET(Z3_" Rx Copay: "_$E(A("RXCP"),1,17)_" Means Tst: "_A("M/T"),$P(RCZZ0,U),RCT,ZZ1) "RTN","RCDPEAA2",123,0) Q "RTN","RCDPEAA2",124,0) ; "RTN","RCDPEAA2",125,0) REVLINES(RCSCR,RCZZ0,RCT,ZZ1) ;called from BLD; set up the reviewed lines "RTN","RCDPEAA2",126,0) ; "RTN","RCDPEAA2",127,0) ; Input - RCSCR = ien of 344.49 (and 344.4) "RTN","RCDPEAA2",128,0) ; RCZZ0 = zero node data at 344.491 "RTN","RCDPEAA2",129,0) ; RCT = sub line # "RTN","RCDPEAA2",130,0) ; ZZ1 = reference to the to the subline in "RTN","RCDPEAA2",131,0) ; file 344.49 for RCSEQ having a decimal "RTN","RCDPEAA2",132,0) N A,A0,B,B0 "RTN","RCDPEAA2",133,0) S A=$J("",10)_"REVIEW STATUS: ("_$S($P(RCZZ0,U,11)="I":"REVIEW IN PROCESS",$P(RCZZ0,U,11)=1:"REVIEWED",1:"NOT REVIEWED") "RTN","RCDPEAA2",134,0) I $P(RCZZ0,U,12) S A=A_" SET BY: "_$E($P($G(^VA(200,$P(RCZZ0,U,12),0)),U),1,20) "RTN","RCDPEAA2",135,0) D SET(A_")",+$P(RCZZ0,U),RCT,ZZ1) "RTN","RCDPEAA2",136,0) S A=0 F S A=$O(^RCY(344.49,RCSCR,1,ZZ1,4,A)) Q:'A S A0=$G(^(A,0)) D "RTN","RCDPEAA2",137,0) . D SET($J("",12)_$$FMTE^XLFDT($P(A0,U),2)_" "_$P($G(^VA(200,+$P(A0,U,2),0)),U)_$S($P(A0,U,4):" LAST EDIT: "_$$FMTE^XLFDT($P(A0,U,4),2),1:""),$P(RCZZ0,U),RCT,ZZ1) "RTN","RCDPEAA2",138,0) . S B=0 F S B=$O(^RCY(344.49,RCSCR,1,ZZ1,4,A,1,B)) Q:'B S B0=$G(^(B,0)) D "RTN","RCDPEAA2",139,0) . . I $L(B0)>64 D SET($J("",15)_$E(B0,1,64),$P(RCZZ0,U),RCT,ZZ1) S B0=" "_$E(B0,65,$L(B0)) ; Split line if > 64 characters in comment line "RTN","RCDPEAA2",140,0) . . D SET($J("",15)_B0,$P(RCZZ0,U),RCT,ZZ1) "RTN","RCDPEAA2",141,0) Q "RTN","RCDPEAA2",142,0) ; "RTN","RCDPEAA2",143,0) ADJLINES(RCZZ0,RCT,ZZ1) ; called from BLD; set up the adjustment lines "RTN","RCDPEAA2",144,0) ; "RTN","RCDPEAA2",145,0) ; Input - RCZZ0 = zero node data at 344.491 "RTN","RCDPEAA2",146,0) ; RCT = sub line # "RTN","RCDPEAA2",147,0) ; ZZ1 = reference to the to the subline in "RTN","RCDPEAA2",148,0) ; file 344.49 for RCSEQ having a decimal "RTN","RCDPEAA2",149,0) N RCAZ,RCAZ0,Z3 "RTN","RCDPEAA2",150,0) S Z3="" "RTN","RCDPEAA2",151,0) D SET($J("",4+RCTL)_"ADJUSTMENTS:",$P(RCZZ0,U),RCT,ZZ1) "RTN","RCDPEAA2",152,0) S RCAZ=0 F S RCAZ=$O(^RCY(344.49,RCSCR,1,ZZ1,1,RCAZ)) Q:'RCAZ S RCAZ0=$G(^(RCAZ,0)) D "RTN","RCDPEAA2",153,0) . S Z3=$J("",6+RCTL)_+RCAZ0_". ",Q=$L(Z3) "RTN","RCDPEAA2",154,0) . I $P(RCAZ0,U,2)=0 S Z3=Z3_"Distributed adj dec for retraction "_$P(RCAZ0,U,4)_": "_$P(RCAZ0,U,3) "RTN","RCDPEAA2",155,0) . I $P(RCAZ0,U,2)=1 S Z3=Z3_"Adjustment distribution to balance receipt: "_$P(RCAZ0,U,3) "RTN","RCDPEAA2",156,0) . I $P(RCAZ0,U,2)=2!($P(RCAZ0,U,2)=4) D "RTN","RCDPEAA2",157,0) . . S Z3=Z3_"ERA payment adjusted from "_$J($P(RCZZ0,U,5)-$P(RCZZ0,U,6),"",2)_" to "_$J(+$P(RCZZ0,U,5),"",2)_" NET: "_$J($P(RCZZ0,U,5)+$P(RCAZ0,U,3),"",2) "RTN","RCDPEAA2",158,0) . I $P(RCAZ0,U,2)=5 S Z3=Z3_"Non-specific payment (ref# "_$P(RCAZ0,U,4)_"): "_$P(RCAZ0,U,3) "RTN","RCDPEAA2",159,0) . I $P(RCAZ0,U,2)=3 S Z3=Z3_"Non-specific retraction (ref# "_$P(RCAZ0,U,4)_"): "_$P(RCAZ0,U,3) "RTN","RCDPEAA2",160,0) . D SET(Z3,$P(RCZZ0,U),RCT,ZZ1) "RTN","RCDPEAA2",161,0) . I $P(RCAZ0,U,9)'="" D SET($J("",Q)_$P(RCAZ0,U,9),$P(RCZZ0,U),RCT,ZZ1) "RTN","RCDPEAA2",162,0) Q "RTN","RCDPEAA2",163,0) ; "RTN","RCDPEAA2",164,0) ; "RTN","RCDPEAA2",165,0) RXLINES(RCZZ0,RCECME,RCT,ZZ1) ; called from BLD ; set up the Pharmacy lines "RTN","RCDPEAA2",166,0) ; "RTN","RCDPEAA2",167,0) ; Input - RCZZ0 = zero node data at 344.491 "RTN","RCDPEAA2",168,0) ; RCECME = ECME # for Pharmacy claims "RTN","RCDPEAA2",169,0) ; RCT = sub line # "RTN","RCDPEAA2",170,0) ; ZZ1 = reference to the to the subline in "RTN","RCDPEAA2",171,0) ; file 344.49 for RCSEQ having a decimal "RTN","RCDPEAA2",172,0) N RXARRAY "RTN","RCDPEAA2",173,0) D GETPHARM^RCDPEWLP($P(RCZZ0,U,7),.RXARRAY) "RTN","RCDPEAA2",174,0) D SET($J("",9)_"ECME #: "_RCECME,$P(RCZZ0,U),RCT,ZZ1) "RTN","RCDPEAA2",175,0) I '$D(RXARRAY) D SET($J("",9)_" Pharmacy data does not exist for this claim",$P(RCZZ0,U),RCT,ZZ1) Q "RTN","RCDPEAA2",176,0) D SET($J("",9)_"Rx/Fill/Release Status: "_RXARRAY("RX")_"/"_RXARRAY("FILL")_"/"_RXARRAY("RELEASED STATUS"),$P(RCZZ0,U),RCT,ZZ1) "RTN","RCDPEAA2",177,0) D SET($J("",9)_"DOS: "_RXARRAY("DOS"),$P(RCZZ0,U),RCT,ZZ1) "RTN","RCDPEAA2",178,0) Q "RTN","RCDPEAA2",179,0) ; "RTN","RCDPEAA2",180,0) HDR ; Creates header lines for the selected EEOB display "RTN","RCDPEAA2",181,0) N RC0,RC4,RC5,Z,RCDA,RCSEQ "RTN","RCDPEAA2",182,0) I '$G(RCIENS) S VALMQUIT=1 Q "RTN","RCDPEAA2",183,0) S RCDA=$P(RCIENS,U),RCSEQ=$P(RCIENS,U,3) "RTN","RCDPEAA2",184,0) S RC0=$G(^RCY(344.4,RCDA,0)),RC4=$G(^RCY(344.4,RCDA,4)),RC5=$G(^RCY(344.4,RCDA,5)) "RTN","RCDPEAA2",185,0) S VALMHDR(1)=$E("ERA Entry #: "_$P(RC0,U)_$J("",31),1,31)_"Total Amt Pd: "_$J(+$P(RC0,U,5),"",2) "RTN","RCDPEAA2",186,0) I +RCSEQ S VALMHDR(2)=$E("Posted Amt: "_$J($P(^TMP("RCDPE-APAR_EEOB_WLDX",$J,RCSEQ),U,5),"",2)_$J("",31),1,31) "RTN","RCDPEAA2",187,0) S VALMHDR(2)=$G(VALMHDR(2))_"Un-posted balance: "_$J($P(^TMP("RCDPE-APAR_EEOB_WLDX",$J,RCSEQ),U,4),"",2) "RTN","RCDPEAA2",188,0) S VALMHDR(3)="Payer Name/ID: "_$P(RC0,U,6)_"/"_$P(RC0,U,3) "RTN","RCDPEAA2",189,0) S Z=+$O(^RCY(344.31,"AERA",RCDA,0)) "RTN","RCDPEAA2",190,0) I Z S VALMHDR(4)="EFT #/TRACE #: "_$$GET1^DIQ(344.31,Z_",",.01,"E")_"/"_$P(RC0,U,2) ; PRCA*4.5*326 "RTN","RCDPEAA2",191,0) I 'Z,$P(RC5,U,2)'="" S VALMHDR(4)="PAPER CHECK #: "_$P(RC5,U,2) "RTN","RCDPEAA2",192,0) S VALMHDR(5)="Posted Receipt #(s): "_$$RCPTS(RCDA,RC0) "RTN","RCDPEAA2",193,0) Q "RTN","RCDPEAA2",194,0) ; "RTN","RCDPEAA2",195,0) RCPTS(RCDA,RC0) ; pull list of 'other receipt #s "RTN","RCDPEAA2",196,0) ; input - RCDA = ien of entry in 344.4 "RTN","RCDPEAA2",197,0) ; RC0 = data string at zero node of entry in 344.4 "RTN","RCDPEAA2",198,0) ; output - RCPTS = returns list of receipts stored at 344.4,.08 and 344.48 multiple "RTN","RCDPEAA2",199,0) N X,RIEN,RCPTS "RTN","RCDPEAA2",200,0) S X=0 "RTN","RCDPEAA2",201,0) S RCPTS=$P($G(^RCY(344,+$P(RC0,U,8),0)),U) "RTN","RCDPEAA2",202,0) I RCPTS="" G RCPTSQ ; receipt not posted to any of EEOB items "RTN","RCDPEAA2",203,0) S RCPTS=RCPTS_"," "RTN","RCDPEAA2",204,0) F S X=$O(^RCY(344.4,RCDA,8,X)) Q:'X S RIEN=+^(X,0) S RCPTS=RCPTS_$P($G(^RCY(344,RIEN,0)),U)_"," "RTN","RCDPEAA2",205,0) S RCPTS=$$TRIM^XLFSTR(RCPTS,"R",",") ; remove orphan comma from last receipt number "RTN","RCDPEAA2",206,0) RCPTSQ ; "RTN","RCDPEAA2",207,0) Q RCPTS "RTN","RCDPEAA2",208,0) ; "RTN","RCDPEAA2",209,0) EXIT ; -- Clean up list "RTN","RCDPEAA2",210,0) K RCFASTXT "RTN","RCDPEAA2",211,0) Q "RTN","RCDPEAA2",212,0) ; "RTN","RCDPEAA2",213,0) PNM4(RCIFN,RCDA,RC) ; Returns either the patient name or patient name/last 4 "RTN","RCDPEAA2",214,0) ; RCIFN = ien of file 344.4 "RTN","RCDPEAA2",215,0) ; RCDA = ien of file 344.41 "RTN","RCDPEAA2",216,0) ; RC = the ien of file 430 "RTN","RCDPEAA2",217,0) N Z,Z0,Q "RTN","RCDPEAA2",218,0) S Z="" "RTN","RCDPEAA2",219,0) I $G(RCIFN)'="" D "RTN","RCDPEAA2",220,0) . S Z0=$G(^RCY(344.4,RCIFN,1,RCDA,0)),Z="" "RTN","RCDPEAA2",221,0) . I $P(Z0,U,2) S Q=+$P($G(^DGCR(399,+$G(^IBM(361.1,+$P(Z0,U,2),0)),0)),U,2),Z=$P($G(^DPT(Q,0)),U)_"/"_$E($P($G(^(0)),U,9),6,9) ; IA 4051 "RTN","RCDPEAA2",222,0) . I $TR(Z,"/")="" S Z=$P(Z0,U,15) "RTN","RCDPEAA2",223,0) I $G(RC)'="" D "RTN","RCDPEAA2",224,0) . S Q=+$P($G(^PRCA(430,RC,0)),U,7) "RTN","RCDPEAA2",225,0) . I Q S Z=$P($G(^DPT(Q,0)),U)_"/"_$E($P($G(^(0)),U,9),6,9) "RTN","RCDPEAA2",226,0) Q Z "RTN","RCDPEAA2",227,0) ; "RTN","RCDPEAA2",228,0) COBN(RC,A) ; Return seq # of selected payer "RTN","RCDPEAA2",229,0) ; A = 'PST' or null to get current bill payer seq # "RTN","RCDPEAA2",230,0) I $G(A)="" S A=$P($G(^DGCR(399,RC,0)),U,21) S:A="" A="P" S:"PST"'[A A="P" "RTN","RCDPEAA2",231,0) I 'A S A=$F("PST",A)-1 S:A<1 A=1 "RTN","RCDPEAA2",232,0) Q A "RTN","RCDPEAA2",233,0) ; "RTN","RCDPEAA2",234,0) COPAY(RCIFN) ; Returns 1 if any not cancelled 1st party bills exist for "RTN","RCDPEAA2",235,0) ; a 3rd party bill or any bills related to this 3rd party bill "RTN","RCDPEAA2",236,0) ; RCIFN = the 3rd party bill # "RTN","RCDPEAA2",237,0) N FIRST,RCTP0,RCTP1,RCTP2 "RTN","RCDPEAA2",238,0) K ^TMP("IBRBF",$J),^TMP($J,"IBRBF") "RTN","RCDPEAA2",239,0) D RELBILL^IBRFN(RCIFN) ; DBIA 3124 "RTN","RCDPEAA2",240,0) S RCTP0=0 F S RCTP0=$O(^TMP("IBRBF",$J,RCIFN,RCTP0)) Q:RCTP0="" S RCTP1=$G(^(RCTP0)) D "RTN","RCDPEAA2",241,0) . I $P(RCTP1,U,3) K ^TMP("IBRBF",$J,RCIFN,RCTP0) Q ; IB cancelled "RTN","RCDPEAA2",242,0) . S RCTP2=$O(^PRCA(430,"B",+$P(RCTP1,U,4),0)) I $P($G(^PRCA(430,+RCTP2,0)),U,8)=39 K ^TMP("IBRBF",$J,RCIFN,RCTP0) ; AR cancelled "RTN","RCDPEAA2",243,0) S FIRST=$S($O(^TMP("IBRBF",$J,RCIFN,0)):1,1:0) "RTN","RCDPEAA2",244,0) K ^TMP("IBRBF",$J),^TMP($J,"IBRBF") "RTN","RCDPEAA2",245,0) Q FIRST "RTN","RCDPEAA2",246,0) ; "RTN","RCDPEAA2",247,0) MARK(RCIENS) ;EP - Protocol action - RCDPE MARK FOR AUTO POST "RTN","RCDPEAA2",248,0) ; Mark for Auto-Post - EEOB on APAR gets marked for auto-post if it passes "RTN","RCDPEAA2",249,0) ; autoposting validation "RTN","RCDPEAA2",250,0) ; Input: RCIENS - Internal IEN of entry in file 344.49^ien of "RTN","RCDPEAA2",251,0) ; 344.491^selectable line item from listman screen "RTN","RCDPEAA2",252,0) ; "RTN","RCDPEAA2",253,0) I '$D(^XUSEC("RCDPEPP",DUZ)) D Q ; PRCA*4.5*318 Added security key check "RTN","RCDPEAA2",254,0) . D FULL^VALM1 "RTN","RCDPEAA2",255,0) . S VALMBCK="R" "RTN","RCDPEAA2",256,0) . W !!,"This action can only be taken by users that have the RCDPEPP security key.",! "RTN","RCDPEAA2",257,0) . D PAUSE^VALM1 "RTN","RCDPEAA2",258,0) ; "RTN","RCDPEAA2",259,0) N RESULT,REASON,LINE,DIR,X,Y,RCERROR,XX,ERADA1,RCDFDA "RTN","RCDPEAA2",260,0) S:$G(RCIENS)="" RCIENS=+$$SEL^RCDPEAA1() "RTN","RCDPEAA2",261,0) Q:'RCIENS "RTN","RCDPEAA2",262,0) I '$$VALID($P(RCIENS,U),$P(RCIENS,U,2),.RESULT) D G MARKQ ; $$VALID split from RCDPEAP - PRCA*4.5*326 "RTN","RCDPEAA2",263,0) . S LINE=$O(RESULT("")) "RTN","RCDPEAA2",264,0) . S REASON=$TR(RESULT(LINE),U,"-") "RTN","RCDPEAA2",265,0) . S DIR(0)="EA",DIR("A",1)="EEOB cannot be marked for Auto-Post for the following reason:" "RTN","RCDPEAA2",266,0) . S DIR("A",2)=REASON "RTN","RCDPEAA2",267,0) . S DIR("A")="PRESS RETURN TO CONTINUE " "RTN","RCDPEAA2",268,0) . W ! D ^DIR K DIR W ! "RTN","RCDPEAA2",269,0) ; EEOB passed validation; ready for Autopost "RTN","RCDPEAA2",270,0) L +^RCY(344.4,$P(RCIENS,U),0):5 I '$T D NOLOCK G MARKQ "RTN","RCDPEAA2",271,0) S ERADA1=$P($G(^RCY(344.49,$P(RCIENS,U),1,$P(RCIENS,U,2),0)),U,9) ; get 344.41 ien (344.491,.09) "RTN","RCDPEAA2",272,0) S RCDFDA(344.41,ERADA1_","_$P(RCIENS,U)_",",6)=1 "RTN","RCDPEAA2",273,0) S RCDFDA(344.41,ERADA1_","_$P(RCIENS,U)_",",6.01)=DUZ ; PRCA*4.5*326 "RTN","RCDPEAA2",274,0) D FILE^DIE("","RCDFDA") "RTN","RCDPEAA2",275,0) D UPDERA($P(RCIENS,U),DUZ) ; PRCA*4.5*326 - also update top level ERA "RTN","RCDPEAA2",276,0) S DIR(0)="EA",DIR("A",1)=$P(RCIENS,U)_"."_ERADA1_" has been marked for auto-post and has been removed from the APAR List." "RTN","RCDPEAA2",277,0) S DIR("A")="PRESS RETURN TO CONTINUE " "RTN","RCDPEAA2",278,0) W ! D ^DIR K DIR W ! "RTN","RCDPEAA2",279,0) L -^RCY(344.4,$P(RCIENS,U),0) "RTN","RCDPEAA2",280,0) MARKQ ; "RTN","RCDPEAA2",281,0) Q "RTN","RCDPEAA2",282,0) ; "RTN","RCDPEAA2",283,0) NOLOCK ; entry cannot be locked "RTN","RCDPEAA2",284,0) N DIR "RTN","RCDPEAA2",285,0) S DIR(0)="EA" "RTN","RCDPEAA2",286,0) S DIR("A",1)="Sorry, another user is editing this ERA entry." "RTN","RCDPEAA2",287,0) S DIR("A",2)="Try again later." "RTN","RCDPEAA2",288,0) S DIR("A",3)="" "RTN","RCDPEAA2",289,0) S DIR("A")="PRESS ENTER TO CONTINUE " "RTN","RCDPEAA2",290,0) D ^DIR "RTN","RCDPEAA2",291,0) Q "RTN","RCDPEAA2",292,0) ; "RTN","RCDPEAA2",293,0) VIEWERA(RCIENS) ; View/Print ERA - protocol entry from APAR EEOB List screen and APAR - EEOB ITEM - SCRATCHPAD screen "RTN","RCDPEAA2",294,0) N RCSCR "RTN","RCDPEAA2",295,0) I RCPROG="RCDPEAA2" S RCSCR=$P(RCIENS,U) "RTN","RCDPEAA2",296,0) I RCPROG="RCDPEAA1" S RCSCR=+$$SEL^RCDPEAA1() "RTN","RCDPEAA2",297,0) I RCSCR>0 D PRERA^RCDPEWL0 "RTN","RCDPEAA2",298,0) Q "RTN","RCDPEAA2",299,0) ; "RTN","RCDPEAA2",300,0) VALID(RCSCR,SCRLINE,RCARRAY) ;Validates Scratchpad line - Used by APAR/Mark for Auto-post - split from RCDPEAP - PRCA*4.5*326 "RTN","RCDPEAA2",301,0) ;Input "RTN","RCDPEAA2",302,0) ; RCSCR - #344.4/#344.49 file IEN "RTN","RCDPEAA2",303,0) ; SCRLINE - Subscript of first scratchpad entry for the ERA line "RTN","RCDPEAA2",304,0) ; RCARRAY - Passed reference to result array "RTN","RCDPEAA2",305,0) ;Output "RTN","RCDPEAA2",306,0) ; OK - Boolean 1 or 0 "RTN","RCDPEAA2",307,0) ; RCARRAY - Array of claim(s) which fail validation "RTN","RCDPEAA2",308,0) ; "RTN","RCDPEAA2",309,0) ; e.g line number 2 "RTN","RCDPEAA2",310,0) ; RCARRAY(2.001)="K800001^NOT AN ACTIVE CLAIM" "RTN","RCDPEAA2",311,0) ; "RTN","RCDPEAA2",312,0) ; e.g. split line number 2 "RTN","RCDPEAA2",313,0) ; RCARRAY(2.001)="K800002^CLAIM REFERRED TO GENERAL COUNCIL" "RTN","RCDPEAA2",314,0) ; RCARRAY(2.006)="K800003^PAYMENT EXCEEDS CLAIM BALANCE" "RTN","RCDPEAA2",315,0) ; "RTN","RCDPEAA2",316,0) N CLAIM,DONE,SEQ,SEQ1,SUB,STATUS,WLINE "RTN","RCDPEAA2",317,0) K RCARRAY,CLARRAY "RTN","RCDPEAA2",318,0) S SUB=SCRLINE,SEQ=$P($G(^RCY(344.49,RCSCR,1,SUB,0)),U),DONE=0 "RTN","RCDPEAA2",319,0) F S SUB=$O(^RCY(344.49,RCSCR,1,SUB)) Q:SUB="" D Q:DONE "RTN","RCDPEAA2",320,0) . ;Get scratchpad N.001 line and data "RTN","RCDPEAA2",321,0) . S WLINE=$G(^RCY(344.49,RCSCR,1,SUB,0)),SEQ1=$P(WLINE,".") I SEQ1'=SEQ S DONE=1 Q "RTN","RCDPEAA2",322,0) . ;Get claim number from N.00N line - ignore suspense lines "RTN","RCDPEAA2",323,0) . S CLAIM=$P(WLINE,U,7) I 'CLAIM Q "RTN","RCDPEAA2",324,0) . ;Claim must be OPEN or ACTIVE "RTN","RCDPEAA2",325,0) . S STATUS=$P($G(^PRCA(430,CLAIM,0)),"^",8) I STATUS'=42,STATUS'=16 S RCARRAY(SEQ1)=$P(WLINE,U,2)_"^NOT AN ACTIVE CLAIM" Q "RTN","RCDPEAA2",326,0) . ;Check that payment does not exceed balance and no pending payments (at the time of auto posting) "RTN","RCDPEAA2",327,0) . S CLARRAY(CLAIM)=+$G(CLARRAY(CLAIM))+$P(WLINE,U,3) I '$$CHECKPAY^RCDPEAP(.CLARRAY,CLAIM) S RCARRAY(SEQ1)=$P(WLINE,U,2)_"^PAYMENT EXCEEDS CLAIM BALANCE" Q "RTN","RCDPEAA2",328,0) . ;Check if referred to general council "RTN","RCDPEAA2",329,0) . I $P($G(^PRCA(430,CLAIM,6)),U,4)]"" S RCARRAY(SEQ1)=$P(WLINE,U,2)_"^CLAIM REFERRED TO GENERAL COUNCIL" Q "RTN","RCDPEAA2",330,0) . ;Check that payment is not negative "RTN","RCDPEAA2",331,0) . I $P(WLINE,U,6)<0 S RCARRAY(SEQ1)=$P(WLINE,U,2)_"^PAYMENT AMOUNT IS NEGATIVE" Q "RTN","RCDPEAA2",332,0) ;Returns 1 if line is OK "RTN","RCDPEAA2",333,0) Q $S($O(RCARRAY(""))]"":0,1:1) "RTN","RCDPEAA2",334,0) ; "RTN","RCDPEAA2",335,0) UPDERA(ERAIEN,RCDUZ) ; Update MARK FOR AUTOPOST USER top level ERA with DUZ from detail line. PRCA*4.5*326 "RTN","RCDPEAA2",336,0) ; MARK FOR AUTOPOST USER is required at ERA level for initial receipt and AR transaction crreation "RTN","RCDPEAA2",337,0) ; so the MARK FOR AUTOPOST USER at the top level will be equal to the last detail line marekd for autopost "RTN","RCDPEAA2",338,0) N FDA,IENS "RTN","RCDPEAA2",339,0) S FDA(344.4,ERAIEN_",",4.04)=RCDUZ "RTN","RCDPEAA2",340,0) D FILE^DIE("","FDA") "RTN","RCDPEAA2",341,0) Q "RTN","RCDPEAA2",342,0) IEN41(IEN,LINE) ; Given a scratch pad line, find the original ERA detail line. PRCA*4.5*332 "RTN","RCDPEAA2",343,0) ; Input: IEN - Internal Entry number of ERA scratchpad from file 344.49 "RTN","RCDPEAA2",344,0) ; LINE - Line from ERA scratchpad file 344.49 "RTN","RCDPEAA2",345,0) N IEN2 "RTN","RCDPEAA2",346,0) S IEN2=$O(^RCY(344.49,IEN,1,"ASEQ",LINE\1,0)) "RTN","RCDPEAA2",347,0) Q +$$GET1^DIQ(344.491,IEN2_","_IEN_",",.09,"E") "RTN","RCDPEAA3") 0^43^B141250003 "RTN","RCDPEAA3",1,0) RCDPEAA3 ;ALB/KML - APAR Screen - callable entry points ;Nov 24, 2014@23:32:24 "RTN","RCDPEAA3",2,0) ;;4.5;Accounts Receivable;**298,304,318,332**;Mar 20, 1995;Build 40 "RTN","RCDPEAA3",3,0) ;Per VA Directive 6402, this routine should not be modified. "RTN","RCDPEAA3",4,0) Q "RTN","RCDPEAA3",5,0) ; "RTN","RCDPEAA3",6,0) SPLIT(RCIENS) ;EP - Protocol action - RCDPE APAR SPLINE LINE "RTN","RCDPEAA3",7,0) ; Split EEOB in APAR "RTN","RCDPEAA3",8,0) ; Input: RCIENS - Internal IEN of entry in file 344.49^ien of "RTN","RCDPEAA3",9,0) ; 344.491^selectable line item from listman screen "RTN","RCDPEAA3",10,0) N DIR,L,RCQUIT,X "RTN","RCDPEAA3",11,0) S RCQUIT=0 "RTN","RCDPEAA3",12,0) D FULL^VALM1 "RTN","RCDPEAA3",13,0) I '$D(^XUSEC("RCDPEPP",DUZ)) D Q ; PRCA*4.5*318 Added security key check "RTN","RCDPEAA3",14,0) . S VALMBCK="R" "RTN","RCDPEAA3",15,0) . W !!,"This action can only be taken by users that have the RCDPEPP security key.",! "RTN","RCDPEAA3",16,0) . D PAUSE^VALM1 "RTN","RCDPEAA3",17,0) S L=0 "RTN","RCDPEAA3",18,0) F S L=$O(^RCY(344.49,$P(RCIENS,U),1,$P(RCIENS,U,2),1,L)) Q:'L I "01"[$P($G(^(L,0)),U,2) D G SPLITQ "RTN","RCDPEAA3",19,0) . S DIR(0)="EA",DIR("A",1)="THIS EEOB IS NOT AVAILABLE TO EDIT/SPLIT",DIR("A")="PRESS RETURN TO CONTINUE " "RTN","RCDPEAA3",20,0) . W ! D ^DIR K DIR "RTN","RCDPEAA3",21,0) I $P($G(^RCY(344.49,$P(RCIENS,U),1,$P(RCIENS,U,2),0)),U,13) D G:RCQUIT SPLITQ "RTN","RCDPEAA3",22,0) . S DIR("A",1)="WARNING! THIS LINE HAS ALREADY BEEN VERIFIED",DIR("A")="ARE YOU SURE YOU WANT TO CONTINUE?: ",DIR(0)="YA",DIR("B")="NO" W ! D ^DIR K DIR "RTN","RCDPEAA3",23,0) . I Y'=1 S RCQUIT=1 "RTN","RCDPEAA3",24,0) K ^TMP("RCDPE_SPLIT_REBLD",$J) "RTN","RCDPEAA3",25,0) S X=+$O(^TMP("RCDPE-EOB_WLDX",$J,""),-1) "RTN","RCDPEAA3",26,0) D SPLIT^RCDPEWL3($P(RCIENS,U),X) "RTN","RCDPEAA3",27,0) I $G(^TMP("RCDPE_SPLIT_REBLD",$J)) K ^TMP("RCDPE_SPLIT_REBLD",$J) D INIT^RCDPEAA2(RCIENS) "RTN","RCDPEAA3",28,0) ; "RTN","RCDPEAA3",29,0) SPLITQ S VALMBCK="R" "RTN","RCDPEAA3",30,0) Q "RTN","RCDPEAA3",31,0) ; "RTN","RCDPEAA3",32,0) REFRESH(RCIENS) ;EP - Protocol action - RCDPE APAR EEOB REFRESH - PRCA*4.5*332 subroutine re-written "RTN","RCDPEAA3",33,0) ; Refresh the entry in file 344.49 to remove all user adjustments "RTN","RCDPEAA3",34,0) ; Input: RCIENS - Internal IEN of entry in file 344.49^ien of "RTN","RCDPEAA3",35,0) ; 344.491^selectable line item from listman screen "RTN","RCDPEAA3",36,0) N DA,DIK,DIR,DONE,IENS,OSEQ,SEQ,X,XX,Y,Z,ZZ,Z0 "RTN","RCDPEAA3",37,0) D FULL^VALM1 "RTN","RCDPEAA3",38,0) S XX=$P(RCIENS,"^",2)_","_$P(RCIENS,"^",1)_"," "RTN","RCDPEAA3",39,0) S SEQ=$$GET1^DIQ(344.491,XX,.01,"I") ; Line Sequence # "RTN","RCDPEAA3",40,0) I '$D(^XUSEC("RCDPEPP",DUZ)) D Q ; PRCA*4.5*318 Added security key check "RTN","RCDPEAA3",41,0) . S VALMBCK="R" "RTN","RCDPEAA3",42,0) . W !!,"This action can only be taken by users that have the RCDPEPP security key.",! "RTN","RCDPEAA3",43,0) . D PAUSE^VALM1 "RTN","RCDPEAA3",44,0) ; "RTN","RCDPEAA3",45,0) S DIR(0)="YA" "RTN","RCDPEAA3",46,0) S DIR("A",1)="This action will delete and rebuild this EEOB Worklist Scratch Pad for Line "_SEQ_"." "RTN","RCDPEAA3",47,0) S DIR("A",2)="All Splits/Edits/Reviews entered for this line will be erased and all entries" "RTN","RCDPEAA3",48,0) S DIR("A",3)="marked as manually verified will be unmarked.",DIR("A",4)=" " "RTN","RCDPEAA3",49,0) S DIR("A")="ARE YOU SURE YOU WANT TO DO THIS? " "RTN","RCDPEAA3",50,0) W ! "RTN","RCDPEAA3",51,0) D ^DIR "RTN","RCDPEAA3",52,0) K DIR "RTN","RCDPEAA3",53,0) I Y'=1 D REFQ Q "RTN","RCDPEAA3",54,0) ; "RTN","RCDPEAA3",55,0) ; First remove Review and Verify information "RTN","RCDPEAA3",56,0) S DA=$P(RCIENS,"^",2),DA(1)=$P(RCIENS,"^",1) "RTN","RCDPEAA3",57,0) S DIE="^RCY(344.49,"_DA(1)_",1,",DA=$P(RCIENS,"^",2),DA(1)=$P(RCIENS,"^",1) "RTN","RCDPEAA3",58,0) S DR=".1///@;.11///@;.12///@;.13///@" "RTN","RCDPEAA3",59,0) D ^DIE "RTN","RCDPEAA3",60,0) S XX=0,DA(2)=DA(1),DA(1)=DA "RTN","RCDPEAA3",61,0) F D Q:'XX "RTN","RCDPEAA3",62,0) . S XX=$O(^RCY(344.49,DA(2),1,DA(1),4,XX)) "RTN","RCDPEAA3",63,0) . Q:'XX "RTN","RCDPEAA3",64,0) . S DA=XX "RTN","RCDPEAA3",65,0) . S DIK="^RCY(344.49,"_DA(2)_",1,"_DA(1)_",4," "RTN","RCDPEAA3",66,0) . D ^DIK "RTN","RCDPEAA3",67,0) ; "RTN","RCDPEAA3",68,0) ; Next remove distributed adjustments "RTN","RCDPEAA3",69,0) S XX=0 "RTN","RCDPEAA3",70,0) F D Q:'XX "RTN","RCDPEAA3",71,0) . S XX=$O(^RCY(344.49,DA(2),1,DA(1),1,XX)) "RTN","RCDPEAA3",72,0) . Q:'XX "RTN","RCDPEAA3",73,0) . S DA=XX,DIK="^RCY(344.49,"_DA(2)_"1,"_DA(1)_",1," "RTN","RCDPEAA3",74,0) . D ^DIK "RTN","RCDPEAA3",75,0) ; "RTN","RCDPEAA3",76,0) ; Finally remove Split/Edited lines "RTN","RCDPEAA3",77,0) K DA "RTN","RCDPEAA3",78,0) S IENS=$P(RCIENS,"^",2)_","_$P(RCIENS,"^",1)_"," "RTN","RCDPEAA3",79,0) D GETS^DIQ(344.491,IENS,"**","I","OSEQ") ; Get Original line values "RTN","RCDPEAA3",80,0) S DA=$P(RCIENS,"^",2)+1,DA(1)=$P(RCIENS,"^",1) "RTN","RCDPEAA3",81,0) K DR "RTN","RCDPEAA3",82,0) S DIE="^RCY(344.49,"_DA(1)_",1," "RTN","RCDPEAA3",83,0) S DR=".02///"_OSEQ(344.491,IENS,.02,"I")_";" ; Original Claim # "RTN","RCDPEAA3",84,0) S DR=DR_".03///"_OSEQ(344.491,IENS,.03,"I")_";" ; Amount to Post on Receipt "RTN","RCDPEAA3",85,0) S DR=DR_".04///"_OSEQ(344.491,IENS,.04,"I")_";" ; Include on Receipt "RTN","RCDPEAA3",86,0) S DR=DR_".05///"_OSEQ(344.491,IENS,.05,"I")_";" ; Amount of Payment "RTN","RCDPEAA3",87,0) S DR=DR_".06///"_OSEQ(344.491,IENS,.06,"I")_";" ; Net Amount of Payment "RTN","RCDPEAA3",88,0) ; "RTN","RCDPEAA3",89,0) ; PRCA*4.5*332 - AR Bill pointer goes in .07 field. It is populated during scratchpad creation "RTN","RCDPEAA3",90,0) ; but when refreshing we need to derive it from the old bill number in the .02 field. "RTN","RCDPEAA3",91,0) S Z0="" "RTN","RCDPEAA3",92,0) S ZZ=OSEQ(344.491,IENS,.02,"I") "RTN","RCDPEAA3",93,0) I ZZ'="" S Z0=$O(^DGCR(399,"B",ZZ,"")) "RTN","RCDPEAA3",94,0) S DR=DR_".07///"_$S(Z0:Z0,1:"@")_";" ; AR Bill (399 or 430 IEN) "RTN","RCDPEAA3",95,0) ; "RTN","RCDPEAA3",96,0) S DR=DR_".08///@;.09///@;.10///@;2.03///@;2.04///@" ; Null out the other fields "RTN","RCDPEAA3",97,0) D ^DIE "RTN","RCDPEAA3",98,0) S XX=DA,DONE=0 "RTN","RCDPEAA3",99,0) F D Q:DONE "RTN","RCDPEAA3",100,0) . S XX=$O(^RCY(344.49,DA(1),1,XX)) "RTN","RCDPEAA3",101,0) . I 'XX S DONE=1 Q "RTN","RCDPEAA3",102,0) . Q:$P($P(^RCY(344.49,DA(1),1,XX,0),"^",1),".",1)'=SEQ ; Not line being refreshed "RTN","RCDPEAA3",103,0) . S DA=XX,DIK="^RCY(344.49,"_DA(1)_",1," "RTN","RCDPEAA3",104,0) . D ^DIK "RTN","RCDPEAA3",105,0) ; "RTN","RCDPEAA3",106,0) D INIT^RCDPEAA2(RCIENS) "RTN","RCDPEAA3",107,0) REFQ ; "RTN","RCDPEAA3",108,0) S VALMBG=1,VALMBCK="R" "RTN","RCDPEAA3",109,0) Q "RTN","RCDPEAA3",110,0) ; "RTN","RCDPEAA3",111,0) RESEARCH ; Invoke the research menu off APAR "RTN","RCDPEAA3",112,0) ; "RTN","RCDPEAA3",113,0) K ^TMP($J,"RC_VALMBG") "RTN","RCDPEAA3",114,0) S ^TMP($J,"RC_VALMBG")=$G(VALMBG) "RTN","RCDPEAA3",115,0) D FULL^VALM1 "RTN","RCDPEAA3",116,0) D EN^VALM("RCDPE APAR EEOB RESEARCH") "RTN","RCDPEAA3",117,0) RQ K ^TMP($J,"RC_VALMBG") "RTN","RCDPEAA3",118,0) Q "RTN","RCDPEAA3",119,0) ; "RTN","RCDPEAA3",120,0) VRECPT(RCIENS) ; "RTN","RCDPEAA3",121,0) ; "RTN","RCDPEAA3",122,0) ; Input - RCIENS = ien of entry in file 344.49^ien of 344.491^selectable line item from listman screen "RTN","RCDPEAA3",123,0) ; "RTN","RCDPEAA3",124,0) D VR^RCDPEWLP($P(RCIENS,U)) "RTN","RCDPEAA3",125,0) Q "RTN","RCDPEAA3",126,0) REVIEW(RCIENS) ; Enter review information on worklist and turn review display on/off "RTN","RCDPEAA3",127,0) ; "RTN","RCDPEAA3",128,0) ; Input - RCIENS = ien of entry in file 344.49^ien of 344.491^selectable line item from listman screen "RTN","RCDPEAA3",129,0) ; "RTN","RCDPEAA3",130,0) ; "RTN","RCDPEAA3",131,0) N Z,RC,RCDA,RCZ,DIC,DA,DIE,DR,X,Y,DIR,REVCHG,RCUSPREF,RCLSTREV,RCREV "RTN","RCDPEAA3",132,0) D FULL^VALM1 "RTN","RCDPEAA3",133,0) ; "RTN","RCDPEAA3",134,0) S REVCHG="" "RTN","RCDPEAA3",135,0) S DIR(0)="YA",RC=+$G(^TMP($J,"RC_REVIEW")) "RTN","RCDPEAA3",136,0) S DIR("A",1)="REVIEW DATA DISPLAY IS CURRENTLY TURNED "_$P("OFF^ON",U,RC+1),DIR("A")="DO YOU WANT TO TURN IT "_$P("ON^OFF",U,RC+1)_"?: ",DIR("B")=$S('RC:"YES",1:"NO") W ! D ^DIR K DIR "RTN","RCDPEAA3",137,0) I Y=1 S ^TMP($J,"RC_REVIEW")=((RC+1)#2),REVCHG=1 "RTN","RCDPEAA3",138,0) S RCUSPREF=+$O(^RCY(344.49,$P(RCIENS,U),2,"B",DUZ,0)) "RTN","RCDPEAA3",139,0) ; "RTN","RCDPEAA3",140,0) I 'RCUSPREF D ; Add the user pref record "RTN","RCDPEAA3",141,0) . S RCUSPREF=+$$ADDUSER($P(RCIENS,U),DUZ) "RTN","RCDPEAA3",142,0) S RCLSTREV=+$P($G(^RCY(344.49,$P(RCIENS,U),2,RCUSPREF,0)),U,2) "RTN","RCDPEAA3",143,0) S DA(1)=$P(RCIENS,U),DA=RCUSPREF "RTN","RCDPEAA3",144,0) I DA,RCLSTREV'=$G(^TMP($J,"RC_REVIEW")) D ; Update user pref "RTN","RCDPEAA3",145,0) . S DIE="^RCY(344.49,"_DA(1)_",2,",DR=".02////"_+$G(^TMP($J,"RC_REVIEW")) D ^DIE "RTN","RCDPEAA3",146,0) W ! "RTN","RCDPEAA3",147,0) I '$G(^TMP($J,"RC_REVIEW")) G REVIEWQ "RTN","RCDPEAA3",148,0) ; "RTN","RCDPEAA3",149,0) D SEL^RCDPEWL(.RCDA) "RTN","RCDPEAA3",150,0) S RCZ=+$O(RCDA(0)),RCZ=+$G(RCDA(RCZ)) G:'RCZ REVIEWQ "RTN","RCDPEAA3",151,0) ; "RTN","RCDPEAA3",152,0) S RCREV=0 "RTN","RCDPEAA3",153,0) I '$O(^RCY(344.49,$P(RCIENS,U),1,"AC",DUZ,RCZ,0)) D "RTN","RCDPEAA3",154,0) . S RCREV=$$NEWREV($P(RCIENS,U),RCZ,DUZ) "RTN","RCDPEAA3",155,0) E D "RTN","RCDPEAA3",156,0) . N DIR,X,Y "RTN","RCDPEAA3",157,0) . S DIR("A")="(A)DD or (E)DIT A REVIEW COMMENT?: ",DIR("B")="ADD",DIR(0)="SA^A:ADD;E:EDIT" W ! D ^DIR K DIR "RTN","RCDPEAA3",158,0) . I $D(DUOUT)!$D(DTOUT) Q "RTN","RCDPEAA3",159,0) . ; "RTN","RCDPEAA3",160,0) . I Y="E" D Q ; Edit a review entry entered by same user "RTN","RCDPEAA3",161,0) .. N DA,DR,DIE,X,Y "RTN","RCDPEAA3",162,0) .. S DA(1)=$P(RCIENS,U),DA=RCZ,DIC="^RCY(344.49,"_DA(1)_",1,"_DA_",4,",DIC(0)="AEMQ",DIC("S")="I $P(^(0),U,2)=DUZ" D ^DIC "RTN","RCDPEAA3",163,0) .. S RCREV=$S(Y>0:+Y,1:0) "RTN","RCDPEAA3",164,0) .. I RCREV S DA(2)=$P(RCIENS,U),DA(1)=RCZ,DA=RCREV,DIE="^RCY(344.49,"_DA(2)_",1,"_DA(1)_",4,",DR=".03;.04////^S X=$$NOW^XLFDT()" D ^DIE "RTN","RCDPEAA3",165,0) . ; "RTN","RCDPEAA3",166,0) . S RCREV=$$NEWREV($P(RCIENS,U),RCZ,DUZ) "RTN","RCDPEAA3",167,0) ; "RTN","RCDPEAA3",168,0) I RCREV S DIE("NO^")="",DA(1)=$P(RCIENS,U),DA=RCZ,DIE="^RCY(344.49,"_DA(1)_",1,",DR=".11R;I X=0 S Y=""@10"";.12////^S X=DUZ;S Y=""@20"";@10;.12///@;@20" D ^DIE K DIE "RTN","RCDPEAA3",169,0) D INIT^RCDPEAA2(RCIENS) "RTN","RCDPEAA3",170,0) S REVCHG="" "RTN","RCDPEAA3",171,0) ; "RTN","RCDPEAA3",172,0) REVIEWQ I $G(REVCHG) D INIT^RCDPEAA2(RCIENS) "RTN","RCDPEAA3",173,0) S VALMBCK="R" "RTN","RCDPEAA3",174,0) Q "RTN","RCDPEAA3",175,0) ; "RTN","RCDPEAA3",176,0) NEWREV(RCSCR,RCZ,RCDUZ) ; Enter a new review comment "RTN","RCDPEAA3",177,0) ; RCSCR = ien of entry in file 344.49 "RTN","RCDPEAA3",178,0) ; RCZ = ien of the EEOB (seq #) "RTN","RCDPEAA3",179,0) ; RCDUZ =DUZ of user entering the comment "RTN","RCDPEAA3",180,0) ; Function returns 0 if no new comment, ien of comment if added "RTN","RCDPEAA3",181,0) N DA,X,Y,DIC,DIK,DLAYGO,DO,DD,RCREV,RCNOW "RTN","RCDPEAA3",182,0) S RCNOW=$$NOW^XLFDT() W !!,"REVIEW DATE/TIME: "_$$FMTE^XLFDT(RCNOW,"2") "RTN","RCDPEAA3",183,0) S DA(2)=RCSCR,DA(1)=RCZ,X=RCNOW,DIC("DR")=".02////"_RCDUZ_";.03",DLAYGO=344.492,DIC(0)="L" "RTN","RCDPEAA3",184,0) S DIC="^RCY(344.49,"_DA(2)_",1,"_DA(1)_",4," "RTN","RCDPEAA3",185,0) K DO,DD "RTN","RCDPEAA3",186,0) D FILE^DICN K DO,DD,DIC,DLAYGO "RTN","RCDPEAA3",187,0) S RCREV=+Y "RTN","RCDPEAA3",188,0) I RCREV'>0 S RCREV=0 G NEWREVQ "RTN","RCDPEAA3",189,0) I '$O(^RCY(344.49,DA(2),1,DA(1),4,RCREV,0)) S DIK="^RCY(344.49,"_DA(2)_",1,"_DA(1)_",4,",DA=RCREV D ^DIK S RCREV=0 ; No comment - delete entry "RTN","RCDPEAA3",190,0) ; "RTN","RCDPEAA3",191,0) NEWREVQ Q RCREV "RTN","RCDPEAA3",192,0) ; "RTN","RCDPEAA3",193,0) ADDUSER(RCSCR,RCDUZ) ; Add user record to user preferences multiple in file 344.49 and initialize all preferences "RTN","RCDPEAA3",194,0) ; RCSCR = ien of entry in file 344.49 "RTN","RCDPEAA3",195,0) ; RCDUZ = the ien of the user "RTN","RCDPEAA3",196,0) N DIC,DA,X,Y,DLAYGO,DO,DD "RTN","RCDPEAA3",197,0) S Y=+$O(^RCY(344.49,RCSCR,2,"B",RCDUZ,0)) "RTN","RCDPEAA3",198,0) I Y G ADDUQ "RTN","RCDPEAA3",199,0) S DLAYGO=344.492,DA(1)=RCSCR,DIC(0)="L",X=RCDUZ,DIC="^RCY(344.49,"_DA(1)_",2,",DIC("DR")=".02////0;.03////N" "RTN","RCDPEAA3",200,0) D FILE^DICN K DIC,DLAYGO "RTN","RCDPEAA3",201,0) ADDUQ Q $S(Y>0:Y,1:0) "RTN","RCDPEAA3",202,0) ; "RTN","RCDPEAA3",203,0) PREOB(RCIENS) ; Print/View EOB detail "RTN","RCDPEAA3",204,0) N RCDA,RCDAZ,Z,Z0 "RTN","RCDPEAA3",205,0) D FULL^VALM1 "RTN","RCDPEAA3",206,0) S RCDA=$P($G(^RCY(344.49,$P(RCIENS,U),1,$P(RCIENS,U,2),0)),U,9) "RTN","RCDPEAA3",207,0) F RCDAZ=1:1:$L(RCDA,",") S RCDAZ(RCDAZ)=$P(RCDA,",",RCDAZ) "RTN","RCDPEAA3",208,0) S Z=0 F S Z=$O(RCDAZ(Z)) Q:'Z D "RTN","RCDPEAA3",209,0) . ; "RTN","RCDPEAA3",210,0) . S Z0=RCDAZ(Z) "RTN","RCDPEAA3",211,0) . I $E(Z0,1,3)="ADJ" D Q "RTN","RCDPEAA3",212,0) .. I $G(^RCY(344.4,RCSCR,2,+$P(Z0,"ADJ",2),0))'="" S RCDAZ(Z)="ADJ^"_+$P(Z0,"ADJ",2) "RTN","RCDPEAA3",213,0) . ; "RTN","RCDPEAA3",214,0) . S Z0=$G(^RCY(344.4,$P(RCIENS,U),1,+Z0,0)) "RTN","RCDPEAA3",215,0) . S RCDAZ(Z)=+Z0_U_$S($P(Z0,U,2):$P(Z0,U,2),1:-1) Q "RTN","RCDPEAA3",216,0) ; "RTN","RCDPEAA3",217,0) D VP^RCDPEWL2($P(RCIENS,U),.RCDAZ) "RTN","RCDPEAA3",218,0) ; "RTN","RCDPEAA3",219,0) S VALMBCK="R" "RTN","RCDPEAA3",220,0) Q "RTN","RCDPEAA3",221,0) ; "RTN","RCDPEAA3",222,0) VERIF(RCIENS) ;EP - Protocol action RCDPE APAR VERIFY "RTN","RCDPEAA3",223,0) ; Entry point to verification options on APAR worklist "RTN","RCDPEAA3",224,0) ; Input: RCIENS - Internal IEN of entry in file 344.49^ien of "RTN","RCDPEAA3",225,0) ; 344.491^selectable line item from listman screen "RTN","RCDPEAA3",226,0) N DIR,DIRUT,DTOUT,DUOUT,RCQUIT,X,Y "RTN","RCDPEAA3",227,0) D FULL^VALM1 "RTN","RCDPEAA3",228,0) I '$D(^XUSEC("RCDPEPP",DUZ)) D Q ; PRCA*4.5*318 Added security key check "RTN","RCDPEAA3",229,0) . S VALMBCK="R" "RTN","RCDPEAA3",230,0) . W !!,"This action can only be taken by users that have the RCDPEPP security key.",! "RTN","RCDPEAA3",231,0) . D PAUSE^VALM1 "RTN","RCDPEAA3",232,0) ; "RTN","RCDPEAA3",233,0) W !!!! "RTN","RCDPEAA3",234,0) S RCQUIT=0 "RTN","RCDPEAA3",235,0) F D Q:RCQUIT "RTN","RCDPEAA3",236,0) . S DIR(0)="SAO^1:MANUAL VERIFICATION;2:REPORT UNVERIFIED DISCREPANCIES;3:QUIT" "RTN","RCDPEAA3",237,0) . S DIR("A",1)="VERIFY EEOBs:" "RTN","RCDPEAA3",238,0) . S DIR("A",2)=" 1 MANUALLY MARK AS VERIFIED" "RTN","RCDPEAA3",239,0) . S DIR("A",3)=" 2 REPORT OF UNVERIFIED WITH DISCREPANCIES" "RTN","RCDPEAA3",240,0) . S DIR("A",4)=" 3 QUIT AND RETURN TO WORKLIST" "RTN","RCDPEAA3",241,0) . S DIR("A")="Select Action: ",DIR("B")="QUIT" W ! D ^DIR K DIR "RTN","RCDPEAA3",242,0) . I Y=3!(Y="")!$D(DUOUT)!$D(DTOUT) S RCQUIT=1 Q "RTN","RCDPEAA3",243,0) . ; "RTN","RCDPEAA3",244,0) . I Y=1 D MVER($P(RCIENS,U)) W !! Q "RTN","RCDPEAA3",245,0) . ; "RTN","RCDPEAA3",246,0) . I Y=2 D RPT^RCDPEV0($P(RCIENS,U)) W !! Q "RTN","RCDPEAA3",247,0) ; "RTN","RCDPEAA3",248,0) S VALMBCK="R" "RTN","RCDPEAA3",249,0) Q "RTN","RCDPEAA3",250,0) ; "RTN","RCDPEAA3",251,0) MVER(RCERA) ; Manually mark an EEOB as verified within APAR "RTN","RCDPEAA3",252,0) ; subroutine cloned from the process that VERIFIES EEOBs off the standard worklist (MVER^RCDPEV) "RTN","RCDPEAA3",253,0) ; but with specific changes to support APAR "RTN","RCDPEAA3",254,0) ; this subroutine only needs to VERIFY one EEOB rather than a list of EEOBs "RTN","RCDPEAA3",255,0) N A,CT,DA,DIE,DR,DTOUT,DUOUT,Z,Z0,Z1,RCT,RCY,RCY0,RCZ0,RCLINE,RCYNUM,DIR,X,Y,RESULT,SPLIT,Q,Q0,DT1,DT2 "RTN","RCDPEAA3",256,0) N VERIFIED "RTN","RCDPEAA3",257,0) S (VERIFIED,RCT)=0,CT=1,Z0="" "RTN","RCDPEAA3",258,0) ; get the EEOB entry ien to determine if already it's already been verified "RTN","RCDPEAA3",259,0) S Z1=$O(^TMP("RCDPE-EOB_WLDX",$J,"")) I Z1 S Z=^TMP("RCDPE-EOB_WLDX",$J,Z1) "RTN","RCDPEAA3",260,0) ; grab the data belonging to the EEOB "RTN","RCDPEAA3",261,0) I Z]"" S Z0=$G(^RCY(344.49,RCERA,1,+$P(Z,U,2),0)) "RTN","RCDPEAA3",262,0) ; get VERIFY data "RTN","RCDPEAA3",263,0) I Z0'="",$P(Z0,U,13) S VERIFIED=1 "RTN","RCDPEAA3",264,0) I VERIFIED D Q "RTN","RCDPEAA3",265,0) . S DIR(0)="EA",DIR("A",1)="THIS EEOB IS ALREADY VERIFIED",DIR("A")="PRESS RETURN TO CONTINUE: " W ! D ^DIR K DIR "RTN","RCDPEAA3",266,0) S RCY=+$P($G(^TMP("RCDPE-EOB_WLDX",$J,Z1)),U,2),RCLINE=+^(Z1),RCYNUM=Z1 "RTN","RCDPEAA3",267,0) S RCY0=$G(^RCY(344.49,RCERA,1,RCY,0)) "RTN","RCDPEAA3",268,0) S RCZ0=$G(^RCY(344.4,RCERA,1,+$P(RCY0,U,9),0)) "RTN","RCDPEAA3",269,0) I '$P(RCZ0,U,2) D "RTN","RCDPEAA3",270,0) . W !!,"THIS LINE DOES NOT REFERENCE A VALID BILL" "RTN","RCDPEAA3",271,0) E D "RTN","RCDPEAA3",272,0) . S RESULT=$$VER^RCDPEV(RCERA,+$G(^IBM(361.1,+$P(RCZ0,U,2),0)),+$P(RCY0,U,9),1) "RTN","RCDPEAA3",273,0) . F Z=2:1:9 I $E($P(RESULT,U,Z))="*" S Q=$P(RESULT,U,Z),$E(Q,1)="",$P(RESULT,U,Z)=Q "RTN","RCDPEAA3",274,0) . S SPLIT=$O(^RCY(344.49,RCERA,1,"B",+RCY0_".9999"),-1)'=(+RCY0_".0001") "RTN","RCDPEAA3",275,0) . S Z=$S(SPLIT:"CLAIM #'s: ",1:" CLAIM #: ") "RTN","RCDPEAA3",276,0) . S Z=Z_$P(RCY0,U,2)_$S('SPLIT:"",1:" (ORIGINAL ERA DATA)") "RTN","RCDPEAA3",277,0) . I SPLIT D "RTN","RCDPEAA3",278,0) .. S Q=+RCY0 F S Q=$O(^RCY(344.49,RCERA,1,"B",Q)) Q:(Q\1)'=+RCY0 S Q0=+$O(^RCY(344.49,RCERA,1,"B",Q,0)),Q0=$G(^RCY(344.49,RCERA,1,Q0,0)) I $P(Q0,U,2)'="" S Z=Z_" "_$P(Q0,U,2) "RTN","RCDPEAA3",279,0) . W !!!,Z "RTN","RCDPEAA3",280,0) . W !,?13,"PATIENT NAME"_$J("",18)_" SUBMITTED AMT SVC DATE(S)" "RTN","RCDPEAA3",281,0) . W !,?13,"------------------------------ --------------- -----------------" "RTN","RCDPEAA3",282,0) . S DT1=$E($S($P(RESULT,U,7):$$FMTE^XLFDT($P(RESULT,U,7),"2D"),1:"NOTFOUND")_$J("",8),1,8) "RTN","RCDPEAA3",283,0) . S DT2=$E($S($P(RESULT,U,9):"-"_$$FMTE^XLFDT($P(RESULT,U,9),"2D"),1:"-NOTFOUND")_$J("",9),1,9) "RTN","RCDPEAA3",284,0) . W !," ERA DATA: ",$E($P(RESULT,U,3)_$J("",30),1,30)," ",$E($J($P(RESULT,U,5),"",2)_$J("",15),1,15)_" "_DT1_DT2 "RTN","RCDPEAA3",285,0) . W !,?15,$P($G(^RCY(344,RCERA,0)),U,6) "RTN","RCDPEAA3",286,0) . S DT1=$E($S($P(RESULT,U,6):$$FMTE^XLFDT($P(RESULT,U,6),"2D"),1:"NOTFOUND")_$J("",8),1,8) "RTN","RCDPEAA3",287,0) . S DT2=$E($S($P(RESULT,U,8):"-"_$$FMTE^XLFDT($P(RESULT,U,8),"2D"),1:"-NOTFOUND")_$J("",9),1,9) "RTN","RCDPEAA3",288,0) . W !," BILL DATA: "_$E($P(RESULT,U,2)_$J("",30),1,30)_" "_$E($J($P(RESULT,U,4),"",2)_$J("",15),1,15)_" "_DT1_DT2 "RTN","RCDPEAA3",289,0) . W !,?15,$P($G(^DIC(36,+$P(RCZ0,U,4),0)),U),! "RTN","RCDPEAA3",290,0) S DIR(0)="YA",DIR("A")="DO YOU WANT TO MARK THIS LINE VERIFIED? ",DIR("B")="NO" W ! D ^DIR K DIR "RTN","RCDPEAA3",291,0) ; "RTN","RCDPEAA3",292,0) I Y'=1 Q "RTN","RCDPEAA3",293,0) S DA(1)=RCERA,DA=+RCY,DIE="^RCY(344.49,"_DA(1)_",1,",DR=".13////1" D ^DIE "RTN","RCDPEAA3",294,0) S A=$$TOPLINE^RCDPEWL1($G(^RCY(344.49,RCERA,1,+RCY,0)),RCYNUM) "RTN","RCDPEAA3",295,0) S ^TMP("RCDPE-EOB_WL",$J,RCLINE,0)=A "RTN","RCDPEAA3",296,0) Q "RTN","RCDPEAA3",297,0) ; "RTN","RCDPEAA3",298,0) ;PRCA*4.5*304 - add a claim comment to the ERA detail line from APAR "RTN","RCDPEAA3",299,0) COMNT ; "RTN","RCDPEAA3",300,0) N IEN,SEQ,DA,DIR,DTOUT,DUOUT,X,Y,DIRUT,DIROUT,ZDA,ZBILL,RCOMMENT,TCOMM "RTN","RCDPEAA3",301,0) S RCOMMENT=0 "RTN","RCDPEAA3",302,0) S IEN=+$P(RCIENS,U,1) "RTN","RCDPEAA3",303,0) ; Validate the selection "RTN","RCDPEAA3",304,0) I IEN=0 D G COMQ "RTN","RCDPEAA3",305,0) . W !,"Cannot comment, no record in file ELECTRONIC REMITTANCE ADVICE file selected." D WAIT^VALM1 "RTN","RCDPEAA3",306,0) S SEQ=$P(^RCY(344.49,IEN,1,+$P(RCIENS,U,2),0),U,9) ; Just grab the first sequence number for the comment. "RTN","RCDPEAA3",307,0) I $G(SEQ)="" D G COMQ "RTN","RCDPEAA3",308,0) . W !,"Cannot comment, no ERA detail record selected." D WAIT^VALM1 "RTN","RCDPEAA3",309,0) I $G(^RCY(344.4,IEN,1,SEQ,0))']"" D G COMQ "RTN","RCDPEAA3",310,0) . W !,"Cannot comment, ERA detail record selected not found." D WAIT^VALM1 "RTN","RCDPEAA3",311,0) ; "RTN","RCDPEAA3",312,0) ; Allow user to put comment on this ERA Detail record "RTN","RCDPEAA3",313,0) S ZDA=SEQ,ZDA(1)=IEN,ZBILL=$P($$GETBILL^RCDPESR0(.ZDA),"-",2) "RTN","RCDPEAA3",314,0) W !,"Enter a comment on ERA #"_IEN_" ERA Detail Seq #",SEQ," Bill #",ZBILL,! "RTN","RCDPEAA3",315,0) S DIE="^RCY(344.4,"_IEN_",1,",DA=SEQ,DA(1)=IEN,DR="4Comment" D ^DIE G:$D(DTOUT)!$D(Y) COMQ "RTN","RCDPEAA3",316,0) ; Now file user (DUZ) and DATE "RTN","RCDPEAA3",317,0) K DR "RTN","RCDPEAA3",318,0) ; If DA is not defined then the user deleted the comment with an @, "RTN","RCDPEAA3",319,0) ; Delete the user and date too. "RTN","RCDPEAA3",320,0) S TCOMM=$$GET1^DIQ(344.41,SEQ_","_IEN_",",4,"E") "RTN","RCDPEAA3",321,0) I TCOMM="" S DA=SEQ,DA(1)=IEN,DR="4.01////@;4.02////@;" "RTN","RCDPEAA3",322,0) E S DR="4.01////"_$$DT^XLFDT_";4.02////"_$G(DUZ)_";" "RTN","RCDPEAA3",323,0) D ^DIE "RTN","RCDPEAA3",324,0) S RCOMMENT=1 "RTN","RCDPEAA3",325,0) D WAIT^VALM1 "RTN","RCDPEAA3",326,0) ; "RTN","RCDPEAA3",327,0) COMQ I RCOMMENT D INIT^RCDPEAA2(RCIENS) ; "RTN","RCDPEAA3",328,0) S VALMBCK="R" "RTN","RCDPEAA3",329,0) Q "RTN","RCDPEAC") 0^12^B169995417 "RTN","RCDPEAC",1,0) RCDPEAC ;ALB/TMK/PJH - ACTIVE BILLS WITH EEOB ON FILE ;Jun 06, 2014@19:11:19 "RTN","RCDPEAC",2,0) ;;4.5;Accounts Receivable;**208,269,276,298,303,326,332**;Mar 20, 1995;Build 40 "RTN","RCDPEAC",3,0) ;Per VA Directive 6402, this routine should not be modified. "RTN","RCDPEAC",4,0) ; "RTN","RCDPEAC",5,0) EN ; Entry point for Active Bills With EEOB Report [RCDPE ACTIVE WITH EEOB REPORT] "RTN","RCDPEAC",6,0) N %ZIS,CHAM,DTOUT,DUOUT,END,HDR,POP,RCCT,RCDISPTY,RCHDR,RCINS,RCLSTMGR,RCPAR,RCPGNUM,RCSORT,RCSTOP,RCTMPND,RCZRO "RTN","RCDPEAC",7,0) N START,TRIC,VAUTD,X,Y "RTN","RCDPEAC",8,0) ; PRCA*4.5*276 - IA 1077 - Query Division "RTN","RCDPEAC",9,0) D DIVISION^VAUTOMA "RTN","RCDPEAC",10,0) I 'VAUTD&($D(VAUTD)'=11) Q "RTN","RCDPEAC",11,0) ; PRCA*4.5*276 - select report format "RTN","RCDPEAC",12,0) Q:'$$SELECT(.RCINS,.RCSORT,.RCZRO,.RCTYPE) "RTN","RCDPEAC",13,0) ; "RTN","RCDPEAC",14,0) S RCTMPND="",RCPGNUM=0,RCSTOP=0 "RTN","RCDPEAC",15,0) I RCLSTMGR D G ENOUT "RTN","RCDPEAC",16,0) . S RCTMPND=$T(+0)_"^AR - ACTIVE BILLS WITH EEOB REPORT" K ^TMP($J,RCTMPND) ; clean any residue "RTN","RCDPEAC",17,0) . D ENQ "RTN","RCDPEAC",18,0) . M HDR=RCHDR "RTN","RCDPEAC",19,0) . D LMRPT^RCDPEARL(.HDR,$NA(^TMP($J,RCTMPND))) ; generate ListMan display "RTN","RCDPEAC",20,0) . I $D(RCTMPND) K ^TMP($J,RCTMPND) "RTN","RCDPEAC",21,0) ; "RTN","RCDPEAC",22,0) W ! "RTN","RCDPEAC",23,0) S %ZIS="QM" D ^%ZIS Q:POP "RTN","RCDPEAC",24,0) I $D(IO("Q")) D Q "RTN","RCDPEAC",25,0) .N ZTDESC,ZTRTN,ZTSAVE,ZTSK "RTN","RCDPEAC",26,0) .S ZTRTN="ENQ^RCDPEAC",ZTDESC="AR - ACTIVE BILLS WITH EEOB REPORT" "RTN","RCDPEAC",27,0) .S ZTSAVE("*")="" "RTN","RCDPEAC",28,0) .D ^%ZTLOAD "RTN","RCDPEAC",29,0) .W !!,$S($D(ZTSK):"Your task number"_ZTSK_" has been queued.",1:"Unable to queue this job.") "RTN","RCDPEAC",30,0) .K IO("Q") D HOME^%ZIS "RTN","RCDPEAC",31,0) U IO "RTN","RCDPEAC",32,0) ; "RTN","RCDPEAC",33,0) ENQ ; Queued entry point for the report "RTN","RCDPEAC",34,0) ; RCSORT and array RCINS must exist "RTN","RCDPEAC",35,0) ; RCINS = "A" for all ins co, "R" for range, "S" for selected individual "RTN","RCDPEAC",36,0) ; for RCINS="R" ("FR")=from payer name and ("TR")=to payer name "RTN","RCDPEAC",37,0) ; for RCINS="S" ("S",INS CO IEN IN FILE 36)="" "RTN","RCDPEAC",38,0) ; RCSORT = "PN" for sort by patient name followed by ;- if reverse order "RTN","RCDPEAC",39,0) ; "L4" for sort by patient SSN followed by ;- if reverse order "RTN","RCDPEAC",40,0) ; "RTN","RCDPEAC",41,0) N POSTDT,RC0,RC399,RC399M1,RC430,RCACT,RCBILL,RCEIEN,RCEOB,RCEX,RCEXT,RCINC,RCKEY2,RCKEY4,RCNEW "RTN","RCDPEAC",42,0) N RCPAYNAM,RCPT,RCSSN,RCSTOP,RCTOT,RCZ,RCZ0,RCZ1,SN,X,Y,Z,Z0 "RTN","RCDPEAC",43,0) K ^TMP($J,"RCSORT") "RTN","RCDPEAC",44,0) S RCCT=0 ;Page count for List Manager "RTN","RCDPEAC",45,0) S RCEXT=0 ; Set Excel page 1 count "RTN","RCDPEAC",46,0) I 'RCLSTMGR D HDRBLD "RTN","RCDPEAC",47,0) I RCLSTMGR D HDRLM "RTN","RCDPEAC",48,0) S RCACT=+$O(^PRCA(430.3,"AC",102,0)) ; Get active status ien "RTN","RCDPEAC",49,0) G:'RCACT ENOUT "RTN","RCDPEAC",50,0) ; "RTN","RCDPEAC",51,0) I 'RCLSTMGR D HDRLST^RCDPEARL(0,.RCHDR) ; initial report header "RTN","RCDPEAC",52,0) S RCBILL=0,RCDT=START-.0001 "RTN","RCDPEAC",53,0) ; PRCA*4.5*303 - Changed loop to use the "AD" index on 361.1 so that the number of records checked is limited by "RTN","RCDPEAC",54,0) ; the START and END dates of when the EEOB was recieved in VistA "RTN","RCDPEAC",55,0) ; PRCA*4.5*326 - Start modified block. Change INCLUDE params and shorten line lengths. "RTN","RCDPEAC",56,0) F S RCDT=$O(^IBM(361.1,"AD",RCDT)) Q:(RCDT>(END_".24"))!(RCDT="") D "RTN","RCDPEAC",57,0) . S RCEIEN="" F S RCEIEN=$O(^IBM(361.1,"AD",RCDT,RCEIEN)) Q:RCEIEN="" D ; "RTN","RCDPEAC",58,0) . . S RCBILL=$P(^IBM(361.1,RCEIEN,0),U,1) "RTN","RCDPEAC",59,0) . . S RCINC=$$INCLUDE(RCBILL,RCEIEN,RCTYPE) ; PRCA*4.5*326 - Inclusion by payer or payer type "RTN","RCDPEAC",60,0) . . I RCINC,($P(^PRCA(430,RCBILL,0),U,8)=RCACT),$$EEOB(RCBILL,.RCEOB,RCZRO) D ; PRCA*4.5*326 "RTN","RCDPEAC",61,0) . . . S (RCTOT,RCEOB,SN)=0 "RTN","RCDPEAC",62,0) . . . F S RCEOB=$O(RCEOB(RCEOB)) Q:'RCEOB F S SN=$O(RCEOB(RCEOB,SN)) Q:'SN D "RTN","RCDPEAC",63,0) . . . . S RCTOT=RCTOT+$G(^IBM(361.1,RCEOB,1)) "RTN","RCDPEAC",64,0) . . . . ; PRCA*4.5*326 - Begin block - Change insurance co. name (file 36) to payer name (file 344.6) "RTN","RCDPEAC",65,0) . . . . S RCPAYNAM=$$INSNM(RCBILL,RCEIEN) "RTN","RCDPEAC",66,0) . . . . S RCKEY2=$$SL1(RCSORT,RCBILL),RCKEY4=+RCEOB(RCEOB,SN)_"_"_RCEOB_"_"_SN "RTN","RCDPEAC",67,0) . . . . S ^TMP($J,"RCSORT",RCPAYNAM,RCKEY2,RCBILL,RCKEY4,RCEOB)=$P(RCEOB(RCEOB,SN),U,2) ; PRCA*4.5.303 add ERA PD AMOUNT "RTN","RCDPEAC",68,0) . . . . I $O(RCEOB(0)) S ^TMP($J,"RCSORT",RCPAYNAM,RCKEY2,RCBILL)=RCTOT ;This is from the eob and will be the same for each line "RTN","RCDPEAC",69,0) . . . . ; PRCA*4.5*326 - End block "RTN","RCDPEAC",70,0) ; "RTN","RCDPEAC",71,0) S RCZ="",(RCSTOP,RCNEW)=0 "RTN","RCDPEAC",72,0) F S RCZ=$O(^TMP($J,"RCSORT",RCZ)) Q:RCZ=""!RCSTOP D S:($G(RCINS)="R")!($G(RCINS)="S")&(RCPGNUM>1) RCNEW=1 "RTN","RCDPEAC",73,0) . I RCSORT'["-" D "RTN","RCDPEAC",74,0) .. S RCZ0="" F S RCZ0=$O(^TMP($J,"RCSORT",RCZ,RCZ0)) Q:RCZ0=""!RCSTOP D OUTPUT(RCZ,RCZ0,RCSORT,.RCSTOP,.RCINS,RCNEW) S RCNEW=0 "RTN","RCDPEAC",75,0) . I RCSORT["-" D "RTN","RCDPEAC",76,0) .. S RCZ0="" F S RCZ0=$O(^TMP($J,"RCSORT",RCZ,RCZ0),-1) Q:RCZ0=""!RCSTOP D OUTPUT(RCZ,RCZ0,RCSORT,.RCSTOP,.RCINS,.RCNEW) S RCNEW=0 "RTN","RCDPEAC",77,0) ; "RTN","RCDPEAC",78,0) I '$D(^TMP($J,"RCSORT")) S $P(Z," ",25)="",Z=Z_"*** NO RECORDS TO PRINT ***" D SL^RCDPEARL(Z,.RCCT,RCTMPND) "RTN","RCDPEAC",79,0) I $D(^TMP($J,"RCSORT")),'RCSTOP D SL^RCDPEARL($$ENDORPRT^RCDPEARL,.RCCT,RCTMPND) "RTN","RCDPEAC",80,0) ; PRCA*4.5*303 - If regular report (no listmanager or queued) ask user to quit "RTN","RCDPEAC",81,0) I 'RCSTOP,'RCLSTMGR,'$D(ZTQUEUED) D ASK^RCDPEARL(.RCSTOP) "RTN","RCDPEAC",82,0) ; "RTN","RCDPEAC",83,0) ENOUT I $D(ZTQUEUED) S ZTREQ="@" "RTN","RCDPEAC",84,0) I '$D(ZTQUEUED) D ^%ZISC "RTN","RCDPEAC",85,0) K ^TMP($J,"RCSORT"),RCDT "RTN","RCDPEAC",86,0) Q "RTN","RCDPEAC",87,0) ; "RTN","RCDPEAC",88,0) OUTPUT(RCZ,RCZ0,RCSORT,RCSTOP,RCINS,RCNEW) ; Output the data "RTN","RCDPEAC",89,0) ; RCZ, RCZ0 are the first 2 sort levels for the array "RTN","RCDPEAC",90,0) ; RCINS = insurance co info array "RTN","RCDPEAC",91,0) ; RCSTOP passed by ref - returned if user chooses to stop "RTN","RCDPEAC",92,0) ; RCNEW = 1 if the header should be forced to print "RTN","RCDPEAC",93,0) N ZZ,RCEPD "RTN","RCDPEAC",94,0) S RCBILL=0 F S RCBILL=$O(^TMP($J,"RCSORT",RCZ,RCZ0,RCBILL)) Q:'RCBILL!RCSTOP S RCZ1="" F S RCZ1=$O(^TMP($J,"RCSORT",RCZ,RCZ0,RCBILL,RCZ1)) Q:RCZ1=""!RCSTOP D "RTN","RCDPEAC",95,0) . I $D(ZTQUEUED),$$S^%ZTLOAD S (RCSTOP,ZTSTOP)=1 K ZTREQ I +$G(RCSTOP) W !!,"***TASK STOPPED BY USER***" Q "RTN","RCDPEAC",96,0) . ; IA 1992 - BILL/CLAIMS file (#399) "RTN","RCDPEAC",97,0) . S RC399=$G(^DGCR(399,RCBILL,0)),RC399M1=$G(^DGCR(399,RCBILL,"M1")),RCPT=+$P(RC399,U,2),RC430=$G(^PRCA(430,RCBILL,0)) ;RC430 is from the top level "RTN","RCDPEAC",98,0) . ; PRCA*4.5*276 - Check for Division "RTN","RCDPEAC",99,0) . I VAUTD=0 Q:$P(RC399,U,22)="" Q:$G(VAUTD($P(RC399,U,22)))="" "RTN","RCDPEAC",100,0) . ; PRCA*4.5*326 remove phamacy check. Now in $$INCLUDE logic "RTN","RCDPEAC",101,0) . S RCSTOP=$$NEWPG(.RCINS,RCNEW) S RCNEW=0 Q:RCSTOP "RTN","RCDPEAC",102,0) . S X=$$GET1^DIQ(430,RCBILL_",",11) "RTN","RCDPEAC",103,0) . ; PRCA*4.5*276 - Row #1: Print last 4 SSN only - Move Bill Number to end "RTN","RCDPEAC",104,0) . S RCSSN=$P($G(^DPT(RCPT,0)),U,9),RCSSN=$E(RCSSN,$L(RCSSN)-3,$L(RCSSN)) "RTN","RCDPEAC",105,0) . I $G(RCDISPTY) S RCEX=$P($G(^DPT(RCPT,0)),U)_"^"_RCSSN_"^"_$TR($P(RC430,U),"-","") "RTN","RCDPEAC",106,0) . E D "RTN","RCDPEAC",107,0) . . S Z=$E($P($G(^DPT(RCPT,0)),U)_$J("",25),1,25)_" "_$E(RCSSN_$J("",5),1,5)_" "_$TR($P(RC430,U),"-","") "RTN","RCDPEAC",108,0) . . D SL^RCDPEARL(Z,.RCCT,RCTMPND) "RTN","RCDPEAC",109,0) . ; PRCA*4.5*276 - Row #2: Move Ins Name, Balance, Amt Bill, Amt Paid "RTN","RCDPEAC",110,0) . S Y=+$G(^TMP($J,"RCSORT",RCZ,RCZ0,RCBILL)) "RTN","RCDPEAC",111,0) . I $G(RCDISPTY) S RCEX=RCEX_"^"_RCZ_"^"_+X_"^"_+$P(RC430,U,3)_"^"_Y ; PRCA*4.5*326 - Use RCZ for insurance name "RTN","RCDPEAC",112,0) . E D "RTN","RCDPEAC",113,0) . . ; PRCA*4.5*326 - Use RCZ for insurance name "RTN","RCDPEAC",114,0) . . S Z=$E(RCZ_$J("",30),1,30)_$E($J("",12)_$J(+X,"",2),1+$L($J(+X,"",2)),12+$L($J(+X,"",2)))_$E($J("",13)_$J(+$P(RC430,U,3),"",2),1+$L($J(+$P(RC430,U,3),"",2)),13+$L($J(+$P(RC430,U,3),"",2)))_$E($J("",13),1,13-$L(Y))_$J(Y,"",2) "RTN","RCDPEAC",115,0) . . D SL^RCDPEARL(Z,.RCCT,RCTMPND) "RTN","RCDPEAC",116,0) . ; PRCA*4.5*276 Do not display Date Referred "RTN","RCDPEAC",117,0) . S RCEOB=0,RCEPD="" F S RCEOB=$O(^TMP($J,"RCSORT",RCZ,RCZ0,RCBILL,RCZ1,RCEOB)) Q:'RCEOB!RCSTOP S RCEPD=$G(^TMP($J,"RCSORT",RCZ,RCZ0,RCBILL,RCZ1,RCEOB)) D "RTN","RCDPEAC",118,0) . . S RCSTOP=$$NEWPG(.RCINS,RCNEW,2) "RTN","RCDPEAC",119,0) . . Q:RCSTOP "RTN","RCDPEAC",120,0) . . S RC0=$G(^IBM(361.1,RCEOB,0)) "RTN","RCDPEAC",121,0) . . ; PRCA*4.5*276 - Row #3: Trace#, Date Rec'd, Date Posted "RTN","RCDPEAC",122,0) . . I $G(RCDISPTY) W !,RCEX_"^"_$P(RC0,U,7)_"^"_$$FMTE^XLFDT($P(RC0,U,5),"2D")_"^"_$S(RCZ1:$$FMTE^XLFDT(+RCZ1,"2D"),1:"")_"^"_RCEPD "RTN","RCDPEAC",123,0) . . E D "RTN","RCDPEAC",124,0) . . . S Z=" "_$P(RC0,U,7)_$J("",50-$L($P(RC0,U,7)))_$J(RCEPD,10,2)_" "_$E($$FMTE^XLFDT($P(RC0,U,5),"2D")_$J("",8),1,8)_" "_$E($S(RCZ1:$$FMTE^XLFDT(+RCZ1,"2D"),1:"")_$J("",8),1,8) "RTN","RCDPEAC",125,0) . . . D SL^RCDPEARL(Z,.RCCT,RCTMPND) "RTN","RCDPEAC",126,0) . I '$G(RCDISPTY) S Z="" D SL^RCDPEARL(Z,.RCCT,RCTMPND) "RTN","RCDPEAC",127,0) ; "RTN","RCDPEAC",128,0) Q "RTN","RCDPEAC",129,0) ; "RTN","RCDPEAC",130,0) INCLUDE(RCZ,EOBIEN,RCTYPE) ; PRCA*4.5*326 change parameters "RTN","RCDPEAC",131,0) ; Function returns 1 if record should be included based on ins co "RTN","RCDPEAC",132,0) ; RCINS = array containing insurance co information "RTN","RCDPEAC",133,0) ; RCZ = ien of the entry in file 430 "RTN","RCDPEAC",134,0) N OK,RCI,RCINM,RCAINP,XX ; PRCA*4.5*326 "RTN","RCDPEAC",135,0) S OK=1 "RTN","RCDPEAC",136,0) S RCI=+$$INS(RCZ) "RTN","RCDPEAC",137,0) ; "RTN","RCDPEAC",138,0) I 'RCI S OK=0 G INCQ ; Not a third party bill "RTN","RCDPEAC",139,0) ; "RTN","RCDPEAC",140,0) ; PRCA*4.5*326 - Start modified block - Check for payer match "RTN","RCDPEAC",141,0) I RCINS'="A" D ; "RTN","RCDPEAC",142,0) . S OK=$$ISSEL^RCDPEU1(361.1,EOBIEN) "RTN","RCDPEAC",143,0) E I RCTYPE'="A" D ; "RTN","RCDPEAC",144,0) . S OK=$$ISTYPE^RCDPEU1(361.1,EOBIEN,RCTYPE) "RTN","RCDPEAC",145,0) ; PRCA*4.5*326 - End modified block "RTN","RCDPEAC",146,0) ; "RTN","RCDPEAC",147,0) INCQ Q OK "RTN","RCDPEAC",148,0) ; "RTN","RCDPEAC",149,0) INSNM(RCZ,EOBIEN) ; Returns the name of payer from the ERA associated with the EOB "RTN","RCDPEAC",150,0) ; If that is null, return the insurance co for bill ien RCZ file 430 "RTN","RCDPEAC",151,0) ; Input: RCZ = Point to bill, file #430 "RTN","RCDPEAC",152,0) ; EOBIEN = Pointer to EOB file 361.1 "RTN","RCDPEAC",153,0) ; Returns: NM = Free text name of Payer from ERA or insurance on bill if ERA not found. "RTN","RCDPEAC",154,0) ; "RTN","RCDPEAC",155,0) N ERAIEN,FILE,NM "RTN","RCDPEAC",156,0) S NM="" "RTN","RCDPEAC",157,0) S ERAIEN=$$EOBERA^RCDPEU1(EOBIEN) "RTN","RCDPEAC",158,0) I ERAIEN S NM=$$GETNAME^RCDPEU1(344.4,ERAIEN) "RTN","RCDPEAC",159,0) I NM="" S NM=$P($G(^DIC(36,+$$INS(RCZ),0)),U) "RTN","RCDPEAC",160,0) Q NM "RTN","RCDPEAC",161,0) ; "RTN","RCDPEAC",162,0) INS(RCZ) ; Returns ien of insurance co for bill ien RCZ from file 430 "RTN","RCDPEAC",163,0) N RC "RTN","RCDPEAC",164,0) S RC=$P($G(^PRCA(430,RCZ,0)),U,9) ;DEBTOR "RTN","RCDPEAC",165,0) Q $S($P($G(^RCD(340,+RC,0)),U)'["DIC(36":"",1:+^(0)) "RTN","RCDPEAC",166,0) ; "RTN","RCDPEAC",167,0) NEWPG(RCINS,RCNEW,RCLINES) ; Check for new page needed, output header "RTN","RCDPEAC",168,0) ; RCINS = ins co selection criteria "RTN","RCDPEAC",169,0) ; RCNEW = 1 to force new page "RTN","RCDPEAC",170,0) ; RCLINES = Number of lines before IOSL to force new page "RTN","RCDPEAC",171,0) ; Function returns 1 if user chooses to stop output "RTN","RCDPEAC",172,0) S RCLINES=$G(RCLINES,5) "RTN","RCDPEAC",173,0) I RCNEW!(($Y+RCLINES)>IOSL) D "RTN","RCDPEAC",174,0) . D:'$G(RCDISPTY) HDRLST^RCDPEARL(.RCSTOP,.RCHDR) "RTN","RCDPEAC",175,0) Q RCSTOP "RTN","RCDPEAC",176,0) ; "RTN","RCDPEAC",177,0) EEOB(RCZ,RCEOB,RCZRO) ; Find all non-MRA EEOBs for bill ien RCZ "RTN","RCDPEAC",178,0) ; Function returns 1 if any valid EEOBs found, 0 if none "RTN","RCDPEAC",179,0) ; RCEOB(eob ien)=date posted returned for valid EEOBs found - "RTN","RCDPEAC",180,0) ; pass by reference "RTN","RCDPEAC",181,0) N OK,Z,Z0,Z00,DET,SN,ZPD,ZINC "RTN","RCDPEAC",182,0) K RCEOB "RTN","RCDPEAC",183,0) ; "RTN","RCDPEAC",184,0) S (Z,OK,SN,ZINC)=0 "RTN","RCDPEAC",185,0) ; IA 4051 for File #361.1 "RTN","RCDPEAC",186,0) F S Z=$O(^IBM(361.1,"B",RCZ,Z)) Q:'Z I $P($G(^IBM(361.1,Z,0)),U,4)'=1 D "RTN","RCDPEAC",187,0) . ; retrieve the EEOB data from ERA Detail sub-entry "RTN","RCDPEAC",188,0) . S (Z0,DET)=0 "RTN","RCDPEAC",189,0) . F S Z0=$O(^RCY(344.4,"ADET",Z,Z0)) Q:'Z0 F S DET=$O(^RCY(344.4,"ADET",Z,Z0,DET)) Q:'DET D ; ERA Detail "RTN","RCDPEAC",190,0) . . ; PRCA*4.5*303 - added check for Zero paid or Paid > 0 check for report. "RTN","RCDPEAC",191,0) . . S ZINC=0,ZPD=+$P($G(^RCY(344.4,Z0,1,DET,0)),U,3) "RTN","RCDPEAC",192,0) . . I (RCZRO="A") S ZINC=1 ; PRCA*4.5*332 "RTN","RCDPEAC",193,0) . . I (RCZRO="Z"),(ZPD=0) S ZINC=1 "RTN","RCDPEAC",194,0) . . I (RCZRO="P"),(ZPD>0) S ZINC=1 ; PRCA*4.5*332 "RTN","RCDPEAC",195,0) . . ; PRCA*4.5*303 - Removed looking for Receipt, include record based on ERA DETAIL POST STATUS "RTN","RCDPEAC",196,0) . . ; PRCA*4.5*303 - Removed check for Receipt (If Z1 is not empty) Changed date to Piece 7 and "RTN","RCDPEAC",197,0) . . ; added check for either 0 paid or paid >0 depending on selection. Added ERA PD AMOUNT as second piece of RCEOB array "RTN","RCDPEAC",198,0) . . I ZINC S SN=SN+1,RCEOB(Z,SN)=+$P($G(^RCY(344.4,Z0,0)),U,7)_U_ZPD,OK=1 ; PRCA*4.5*332 "RTN","RCDPEAC",199,0) ; "RTN","RCDPEAC",200,0) Q OK "RTN","RCDPEAC",201,0) ; "RTN","RCDPEAC",202,0) SL1(RCSORT,RCZ) ; Function returns 1st sort level data from ien RCZ in file 430 "RTN","RCDPEAC",203,0) ; RCSORT = "PN" for patient name sort = "L4" for SSN last 4 sort "RTN","RCDPEAC",204,0) N DAT "RTN","RCDPEAC",205,0) I RCSORT="PN" S DAT=$P($G(^DPT(+$P($G(^PRCA(430,RCZ,0)),U,7),0)),U) "RTN","RCDPEAC",206,0) I RCSORT="L4" S DAT=$P($G(^DPT(+$P($G(^PRCA(430,RCZ,0)),U,7),0)),U,9),DAT=$E(DAT,$L(DAT)-3,$L(DAT)) "RTN","RCDPEAC",207,0) Q $S($G(DAT)'="":DAT,1:" ") "RTN","RCDPEAC",208,0) ; "RTN","RCDPEAC",209,0) SELECT(RCINS,RCSORT,RCZRO,RCTYPE) ; Select insurance co, sort criteria, Zero Payment, Bill type (Med/RX) and if output for EXCEL format is selected "RTN","RCDPEAC",210,0) ; Function returns values selected for RCSORT and RCINS - passed by ref "RTN","RCDPEAC",211,0) N RCQUIT,DONE,DIR,X,Y,%DT "RTN","RCDPEAC",212,0) S (RCQUIT,DONE,RCLSTMGR)=0 "RTN","RCDPEAC",213,0) ; PRCA*4.5*326 - Begin changed block - Ask to show Medical/Pharmacy Tricare or All "RTN","RCDPEAC",214,0) S RCTYPE=$$RTYPE^RCDPEU1("") "RTN","RCDPEAC",215,0) I RCTYPE=-1 G SELQ "RTN","RCDPEAC",216,0) ; "RTN","RCDPEAC",217,0) S RCINS=$$PAYRNG^RCDPEU1() "RTN","RCDPEAC",218,0) I RCINS=-1 G SELQ "RTN","RCDPEAC",219,0) ; "RTN","RCDPEAC",220,0) I RCINS'="A" D I XX=-1 G SELQ "RTN","RCDPEAC",221,0) . S RCPAR("TYPE")=RCTYPE "RTN","RCDPEAC",222,0) . S RCPAR("SELC")=RCINS "RTN","RCDPEAC",223,0) . S RCPAR("DICA")="SELECT INSURANCE COMPANY: " "RTN","RCDPEAC",224,0) . S XX=$$SELPAY^RCDPEU1(.RCPAR) "RTN","RCDPEAC",225,0) ; PRCA*4.5*326 - End changed block "RTN","RCDPEAC",226,0) ; "RTN","RCDPEAC",227,0) ; PRCA*4.5*303 - Add Zero $ Prompt and Medical/Pharmacy EEOBs Prompt "RTN","RCDPEAC",228,0) S DIR(0)="SA^P:PAYMENT EEOBs;Z:ZERO PAYMENT EEOBs;A:ALL" "RTN","RCDPEAC",229,0) S DIR("A")="RUN REPORT FOR (P)AYMENT EEOBs or (Z)ERO PAYMENT EEOBs or (A)LL: ",DIR("B")="ALL" "RTN","RCDPEAC",230,0) W ! D ^DIR K DIR "RTN","RCDPEAC",231,0) I $D(DTOUT)!$D(DUOUT) G SELQ "RTN","RCDPEAC",232,0) S RCZRO=$E(Y,1) "RTN","RCDPEAC",233,0) ; "RTN","RCDPEAC",234,0) S DIR(0)="SA^P:PATIENT NAME;L:LAST 4 OF PATIENT SSN",DIR("A")="WITHIN INS CO, SORT BY (P)ATIENT NAME OR (L)AST 4 OF SSN?: ",DIR("B")="PATIENT NAME" W ! D ^DIR K DIR "RTN","RCDPEAC",235,0) I $D(DTOUT)!$D(DUOUT) G SELQ "RTN","RCDPEAC",236,0) S RCSORT=$S(Y="P":"PN",1:"L4") "RTN","RCDPEAC",237,0) S DIR(0)="SA^F:FIRST TO LAST;L:LAST TO FIRST",DIR("A")="SORT "_$S(RCSORT="PN":"PATIENT NAME",1:"LAST 4")_" (F)IRST TO LAST OR (L)AST TO FIRST?: ",DIR("B")="FIRST TO LAST" D ^DIR K DIR "RTN","RCDPEAC",238,0) I $D(DTOUT)!$D(DUOUT) G SELQ "RTN","RCDPEAC",239,0) I Y="L" S RCSORT=RCSORT_";-" "RTN","RCDPEAC",240,0) ; "RTN","RCDPEAC",241,0) ; PRCA*4.5*298 - Add Date Range Prompts "RTN","RCDPEAC",242,0) K DIR "RTN","RCDPEAC",243,0) S DIR("?")="ENTER THE EARLIEST RECEIVED DATE TO INCLUDE ON THE REPORT" "RTN","RCDPEAC",244,0) S DIR(0)="DAO^:"_DT_":APE",DIR("A")="START DATE (RECEIVED): ",DIR("B")="T" D ^DIR K DIR "RTN","RCDPEAC",245,0) I $D(DTOUT)!$D(DUOUT)!(Y="") G SELQ "RTN","RCDPEAC",246,0) S START=Y "RTN","RCDPEAC",247,0) K DIR "RTN","RCDPEAC",248,0) S DIR("?")="ENTER THE LATEST RECEIVED DATE TO INCLUDE ON THE REPORT" "RTN","RCDPEAC",249,0) S DIR("B")="T" "RTN","RCDPEAC",250,0) S DIR(0)="DAO^"_START_":"_DT_":APE",DIR("A")="END DATE (RECEIVED): " D ^DIR K DIR "RTN","RCDPEAC",251,0) I $D(DTOUT)!$D(DUOUT)!(Y="") G SELQ "RTN","RCDPEAC",252,0) S END=Y "RTN","RCDPEAC",253,0) ; PRCA*4.5*326 - Remove old Tricare and CHAMPVA prompts "RTN","RCDPEAC",254,0) ; "RTN","RCDPEAC",255,0) ; PRCA*4.5*276 - Determine whether to gather data for Excel report. "RTN","RCDPEAC",256,0) S RCDISPTY=$$DISPTY^RCDPEM3 G SELQ:RCDISPTY<0 "RTN","RCDPEAC",257,0) I RCDISPTY D INFO^RCDPEM6 S DONE=1 G SELQ "RTN","RCDPEAC",258,0) ; "RTN","RCDPEAC",259,0) ; PRCA*4.5*298 - Add ListManager Prompts "RTN","RCDPEAC",260,0) S RCLSTMGR=$$ASKLM^RCDPEARL G:RCLSTMGR<0 SELQ "RTN","RCDPEAC",261,0) ; "RTN","RCDPEAC",262,0) S DONE=1 "RTN","RCDPEAC",263,0) ; "RTN","RCDPEAC",264,0) SELQ ; "RTN","RCDPEAC",265,0) Q DONE "RTN","RCDPEAC",266,0) ; "RTN","RCDPEAC",267,0) LIST(DIR,RCINS) ; Sets up help array for ins co selected in DIR("?") "RTN","RCDPEAC",268,0) N CT,Z "RTN","RCDPEAC",269,0) S CT=1 "RTN","RCDPEAC",270,0) I '$O(RCINS("S",0)) S DIR("?")="NO INSURANCE COMPANIES SELECTED" Q "RTN","RCDPEAC",271,0) S DIR("?",1)="INSURANCE COMPANIES ALREADY SELECTED:" "RTN","RCDPEAC",272,0) S Z=0 F S Z=$O(RCINS("S",Z)) Q:'Z S CT=CT+1,DIR("?",CT)=" "_$P($G(^DIC(36,Z,0)),U) "RTN","RCDPEAC",273,0) S DIR("?")=" " "RTN","RCDPEAC",274,0) Q "RTN","RCDPEAC",275,0) ; "RTN","RCDPEAC",276,0) HDRBLD ; create the report header "RTN","RCDPEAC",277,0) ; returns RCHDR,RCPGNUM,RCSTOP "RTN","RCDPEAC",278,0) ; RCHDR(0) = header text line count "RTN","RCDPEAC",279,0) ; RCHDR("PGNUM") = page number "RTN","RCDPEAC",280,0) ; RCHDR("XECUTE") = M code for page number "RTN","RCDPEAC",281,0) ; RCHDR("RUNDATE") = date/time report generated "RTN","RCDPEAC",282,0) ; RCPGNUM - page counter "RTN","RCDPEAC",283,0) ; RCSTOP - flag to stop listing "RTN","RCDPEAC",284,0) ; INPUT: "RTN","RCDPEAC",285,0) ; RCDTRNG - date range filter value to be printed as part of the header "RTN","RCDPEAC",286,0) ; RCPAY - Payer filter value(s) "RTN","RCDPEAC",287,0) ; RCLSTMGR "RTN","RCDPEAC",288,0) ; "RTN","RCDPEAC",289,0) N Z0 "RTN","RCDPEAC",290,0) S Z0="" "RTN","RCDPEAC",291,0) K RCHDR S RCHDR("RUNDATE")=$$NOW^RCDPEARL,RCPGNUM=0,RCSTOP=0 "RTN","RCDPEAC",292,0) ; "RTN","RCDPEAC",293,0) I RCDISPTY D Q ; Excel format, xecute code is QUIT, null page number "RTN","RCDPEAC",294,0) . S RCHDR(0)=1,RCHDR("XECUTE")="Q",RCPGNUM="" "RTN","RCDPEAC",295,0) . S RCHDR(1)="PATIENT NAME^SSN^BILL#^INS CO NAME^BALANCE^AMT BILLE^AMT PAID^TRACE#^DT REC'D^DT POST^ERA PD AMT" "RTN","RCDPEAC",296,0) ; "RTN","RCDPEAC",297,0) N MSG,DATE,Y,DIV,HCNT "RTN","RCDPEAC",298,0) S RCHDR(1)=$$HDRNM,HCNT=1 ; line 1 will be replaced by XECUTE code below "RTN","RCDPEAC",299,0) S RCHDR("XECUTE")="N Y S RCPGNUM=RCPGNUM+1,Y=$$HDRNM^"_$T(+0)_"_$S(RCLSTMGR:"""",1:$J(""Page: ""_RCPGNUM,12)),RCHDR(1)=$J("" "",80-$L(Y)\2)_Y" "RTN","RCDPEAC",300,0) ; "RTN","RCDPEAC",301,0) S Y="RUN DATE: "_RCHDR("RUNDATE"),HCNT=HCNT+1,RCHDR(HCNT)=$J("",80-$L(Y)\2)_Y "RTN","RCDPEAC",302,0) I VAUTD=1 S Y="DIVISIONS: ALL" "RTN","RCDPEAC",303,0) I VAUTD=0 D "RTN","RCDPEAC",304,0) . S Z0=0,Y="DIVISIONS: " F X=1:1 S Z0=$O(VAUTD(Z0)) Q:Z0="" S:X>1 Y=Y_", " S Y=Y_VAUTD(Z0) "RTN","RCDPEAC",305,0) S HCNT=HCNT+1,RCHDR(HCNT)=$J("",80-$L(Y)\2)_Y "RTN","RCDPEAC",306,0) I RCINS="S" S Z=0,Z0="" F S Z=$O(RCINS("S",Z)) Q:'Z S Z0=Z0_$S(Z0'="":",",1:"")_$P($G(^DIC(36,Z,0)),U) "RTN","RCDPEAC",307,0) ; PRCA*4.5*326 - Start modified block "RTN","RCDPEAC",308,0) S Z0="PAYERS: "_$S(RCINS="A":"ALL ",RCINS="R":"RANGE",1:"SELECTED") "RTN","RCDPEAC",309,0) S Z0=Z0_$J("",16)_"MEDICAL/PHARMACY/TRICARE: "_$S(RCTYPE="M":"MEDICAL",RCTYPE="P":"PHARMACY",RCTYPE="T":"TRICARE",1:"ALL") "RTN","RCDPEAC",310,0) S HCNT=HCNT+1,RCHDR(HCNT)=$J("",80-$L(Z0)\2)_Z0,Z0="" "RTN","RCDPEAC",311,0) ; PRCA*4.5*326 modify next two lines for tricare filter "RTN","RCDPEAC",312,0) S Z0=Z0_"DATE RANGE: "_$$FMTE^XLFDT(START,"2Z")_"-"_$$FMTE^XLFDT(END,"2Z") "RTN","RCDPEAC",313,0) S Z0=Z0_$J("",16)_" PAYMENT TYPE: "_$S(RCZRO="Z":"ZERO PAYMENT",RCZRO="P":"PAYMENT",1:"ALL") ; PRCA*4.5*332 "RTN","RCDPEAC",314,0) ; PRCA*4.5*326 - End modified block "RTN","RCDPEAC",315,0) ; "RTN","RCDPEAC",316,0) S HCNT=HCNT+1,RCHDR(HCNT)=$J("",80-$L(Z0)\2)_Z0 "RTN","RCDPEAC",317,0) ; "RTN","RCDPEAC",318,0) S HCNT=HCNT+1,RCHDR(HCNT)="" "RTN","RCDPEAC",319,0) S Y="PATIENT NAME SSN BILL#",HCNT=HCNT+1,RCHDR(HCNT)=Y "RTN","RCDPEAC",320,0) S Y="INS CO NAME BALANCE AMT BILLED AMT PAID",HCNT=HCNT+1,RCHDR(HCNT)=Y "RTN","RCDPEAC",321,0) S Y=" TRACE# ERA PD AMT REC'D DT POST",HCNT=HCNT+1,RCHDR(HCNT)=Y "RTN","RCDPEAC",322,0) S Y=$TR($J("",IOM)," ","="),HCNT=HCNT+1,RCHDR(HCNT)=Y "RTN","RCDPEAC",323,0) S RCHDR(0)=HCNT "RTN","RCDPEAC",324,0) Q "RTN","RCDPEAC",325,0) ; "RTN","RCDPEAC",326,0) HDRLM ; create the list manager version of the report header "RTN","RCDPEAC",327,0) ; returns RCHDR,RCPGNUM,RCSTOP "RTN","RCDPEAC",328,0) ; RCHDR(0) = header text line count "RTN","RCDPEAC",329,0) ; RCHDR("PGNUM") = page number "RTN","RCDPEAC",330,0) ; RCHDR("XECUTE") = M code for page number "RTN","RCDPEAC",331,0) ; RCHDR("RUNDATE") = date/time report generated "RTN","RCDPEAC",332,0) ; RCPGNUM - page counter "RTN","RCDPEAC",333,0) ; RCSTOP - flag to stop listing "RTN","RCDPEAC",334,0) ;INPUT: "RTN","RCDPEAC",335,0) ; RCDTRNG - date range filter value to be printed as part of the header "RTN","RCDPEAC",336,0) ; RCPAY - Payer filter value(s) "RTN","RCDPEAC",337,0) ; RCLSTMGR "RTN","RCDPEAC",338,0) ; "RTN","RCDPEAC",339,0) N Z0 S Z0="" "RTN","RCDPEAC",340,0) K RCHDR S RCPGNUM=0,RCSTOP=0 "RTN","RCDPEAC",341,0) N MSG,DATE,Y,DIV,HCNT "RTN","RCDPEAC",342,0) ; PRCA*4.5*326 Start modified code block "RTN","RCDPEAC",343,0) S HCNT=1 "RTN","RCDPEAC",344,0) S RCHDR("TITLE")=$$HDRNM,RCHDR("XECUTE")="Q" "RTN","RCDPEAC",345,0) S RCHDR(1)="DATE RANGE: "_$$FMTE^XLFDT(START,"2Z")_"-"_$$FMTE^XLFDT(END,"2Z")_$J("",16) "RTN","RCDPEAC",346,0) S RCHDR(1)=RCHDR(1)_" PAYMENT TYPE: "_$S(RCZRO="Z":"ZERO PAYMENT",RCZRO="P":"PAYMENT",1:"ALL") ; PRCA*4.5*332 "RTN","RCDPEAC",347,0) I VAUTD=1 S Y="DIVISIONS: ALL" "RTN","RCDPEAC",348,0) I VAUTD=0 D "RTN","RCDPEAC",349,0) . S Z0=0,Y="DIVISIONS: " F X=1:1 S Z0=$O(VAUTD(Z0)) Q:Z0="" S:X>1 Y=Y_", " S Y=Y_VAUTD(Z0) "RTN","RCDPEAC",350,0) S HCNT=HCNT+1,RCHDR(HCNT)=Y "RTN","RCDPEAC",351,0) I RCINS="S" S Z=0,Z0="" F S Z=$O(RCINS("S",Z)) Q:'Z S Z0=Z0_$S(Z0'="":",",1:"")_$P($G(^DIC(36,Z,0)),U) "RTN","RCDPEAC",352,0) S Z0="PAYERS: "_$S(RCINS="A":"ALL ",RCINS="R":"RANGE",1:"SELECTED") "RTN","RCDPEAC",353,0) S Z0=Z0_$J("",44-$L(Z0))_"MEDICAL/PHARMACY/TRICARE: "_$S(RCTYPE="M":"MEDICAL",RCTYPE="P":"PHARMACY",RCTYPE="T":"TRICARE",1:"ALL") "RTN","RCDPEAC",354,0) ; PRCA*4.5*326 End modified code block "RTN","RCDPEAC",355,0) S HCNT=HCNT+1,RCHDR(HCNT)=Z0 "RTN","RCDPEAC",356,0) I RCINS="A" S HCNT=HCNT+1,RCHDR(HCNT)="" "RTN","RCDPEAC",357,0) ; "RTN","RCDPEAC",358,0) S Y="PATIENT NAME SSN BILL#",HCNT=HCNT+1,RCHDR(HCNT)=Y "RTN","RCDPEAC",359,0) S Y="INS CO NAME BALANCE AMT BILLED AMT PAID",HCNT=HCNT+1,RCHDR(HCNT)=Y "RTN","RCDPEAC",360,0) S Y=" TRACE# ERA PD AMT REC'D DT POST",HCNT=HCNT+1,RCHDR(HCNT)=Y "RTN","RCDPEAC",361,0) S RCHDR(0)=HCNT "RTN","RCDPEAC",362,0) Q "RTN","RCDPEAC",363,0) ; "RTN","RCDPEAC",364,0) ; extrinsic variable, name for header PRCA*4.5*298 "RTN","RCDPEAC",365,0) HDRNM() Q "EDI LOCKBOX ACTIVE BILLS W/EEOB REPORT" "RTN","RCDPEAD") 0^46^B232051747 "RTN","RCDPEAD",1,0) RCDPEAD ;ALB/PJH - AUTO DECREASE ;Jun 06, 2014@19:11:19 "RTN","RCDPEAD",2,0) ;;4.5;Accounts Receivable;**298,304,318,326,332**;Mar 20, 1995;Build 40 "RTN","RCDPEAD",3,0) ;Per VA Directive 6402, this routine should not be modified. "RTN","RCDPEAD",4,0) ;Read ^IBM(361.1) via Private IA 4051 "RTN","RCDPEAD",5,0) ; "RTN","RCDPEAD",6,0) EN ;Auto Decrease - applies to auto-posted claims only "RTN","RCDPEAD",7,0) N RCAMT,RCDATE,RCDAY,RCSTART,RCITEM "RTN","RCDPEAD",8,0) N RC344610,RCMDAP,RCMDAD,RCJ,RCK,RCIARR,J "RTN","RCDPEAD",9,0) ; BEGIN PRCA*4.5*326 - added EN1A subroutine "RTN","RCDPEAD",10,0) ; "RTN","RCDPEAD",11,0) ; Quit if medical auto posting is OFF "RTN","RCDPEAD",12,0) Q:'$$GET1^DIQ(344.61,"1,",.02,"I") "RTN","RCDPEAD",13,0) ; "RTN","RCDPEAD",14,0) ; Quit if medical auto decrease of payment lines is OFF "RTN","RCDPEAD",15,0) Q:'$$GET1^DIQ(344.61,"1,",.03,"I") "RTN","RCDPEAD",16,0) ; "RTN","RCDPEAD",17,0) ; Get the RCDPE PARAMETER file #344.61 field.04 AUTO DECREASE MED DAYS DEFAULT value and "RTN","RCDPEAD",18,0) ; calculate process date by subtracting this value from today's date "RTN","RCDPEAD",19,0) S RCDAY=$$FMADD^XLFDT(DT\1,-$$GET1^DIQ(344.61,"1,",.04)) "RTN","RCDPEAD",20,0) ; "RTN","RCDPEAD",21,0) ; Search ERA's paid lines requiring auto-decrease "RTN","RCDPEAD",22,0) D EN1A(RCDAY,1) "RTN","RCDPEAD",23,0) ; "RTN","RCDPEAD",24,0) ; Quit if medical auto decrease of no-payment lines is OFF "RTN","RCDPEAD",25,0) Q:'$$GET1^DIQ(344.61,"1,",.11,"I") "RTN","RCDPEAD",26,0) ; "RTN","RCDPEAD",27,0) ; Get days to wait for no-pay lines "RTN","RCDPEAD",28,0) S RCDAY=$$FMADD^XLFDT(DT\1,-$$GET1^DIQ(344.61,"1,",.12)) "RTN","RCDPEAD",29,0) ; Search ERA's for no pay lines requiring auto-decrease "RTN","RCDPEAD",30,0) D EN1A(RCDAY,2) "RTN","RCDPEAD",31,0) ; "RTN","RCDPEAD",32,0) ; Payer Rejects "RTN","RCDPEAD",33,0) D REJ "RTN","RCDPEAD",34,0) ; "RTN","RCDPEAD",35,0) ; END PRCA*4.5*326 "RTN","RCDPEAD",36,0) Q "RTN","RCDPEAD",37,0) ; "RTN","RCDPEAD",38,0) EN1A(RCDAY,PAID) ; Scan ERA's for auto-posted lines on RCDAY "RTN","RCDPEAD",39,0) ; INPUT RCDAY - Day to search for auto-posted but not decreased lines "RTN","RCDPEAD",40,0) ; PAID - 1 = decrease paid lines only, 2 = decrease no-pay lines only "RTN","RCDPEAD",41,0) ; OUTPUT - Auto-decreases claims "RTN","RCDPEAD",42,0) ; "RTN","RCDPEAD",43,0) ; PRCA*4.5*304 - removed generic auto-decrease amount. Now auto-decrease is by CARC "RTN","RCDPEAD",44,0) ; Allow for a range of dates in future - currently only checks for RCDAY "RTN","RCDPEAD",45,0) ; "RTN","RCDPEAD",46,0) ; Scan F index for ERA within date range "RTN","RCDPEAD",47,0) S RCDATE=$$FMADD^XLFDT(RCDAY,-1) "RTN","RCDPEAD",48,0) F S RCDATE=$O(^RCY(344.4,"F",RCDATE)) Q:'RCDATE Q:(RCDATE\1)>RCDAY D "RTN","RCDPEAD",49,0) . ; "RTN","RCDPEAD",50,0) . ; Scan "F" index of ERA file for ERA entries with AUTOPOST DATE field #4.03 matching RCDAY "RTN","RCDPEAD",51,0) . D EN2(RCDATE,RCDAY,PAID) "RTN","RCDPEAD",52,0) Q "RTN","RCDPEAD",53,0) ; "RTN","RCDPEAD",54,0) EN2(RCDATE,RCDAY,PAID) ; Scans the 'F' index of the ERA file for ERA entries with an - PRCA*4.5*326 "RTN","RCDPEAD",55,0) ; AUTOPOST DATE field (#4.03) matching RCDAY "RTN","RCDPEAD",56,0) ; Input: RCDATE - Current date being search "RTN","RCDPEAD",57,0) ; RCDAY - AUTO DECREASES MED DAYS DEFAULT (File 344.61, field .04) "RTN","RCDPEAD",58,0) ; PAID - 1 = decrease paid lines, 2 = decrease no-pay lines "RTN","RCDPEAD",59,0) N PAYID,PAYNAM,RCERA,RCRTYPE "RTN","RCDPEAD",60,0) S RCERA=0 "RTN","RCDPEAD",61,0) F S RCERA=$O(^RCY(344.4,"F",RCDATE,RCERA)) Q:'RCERA D "RTN","RCDPEAD",62,0) . N RC3446,RCPARM "RTN","RCDPEAD",63,0) . ; "RTN","RCDPEAD",64,0) . ; Quit if ERA is for Pharmacy "RTN","RCDPEAD",65,0) . S RCRTYPE=$$PHARM^RCDPEAP1(RCERA) "RTN","RCDPEAD",66,0) . Q:RCRTYPE "RTN","RCDPEAD",67,0) . ; "RTN","RCDPEAD",68,0) . ; Check payer exclusion file for this ERA's payer "RTN","RCDPEAD",69,0) . S PAYID=$P($G(^RCY(344.4,RCERA,0)),U,3) "RTN","RCDPEAD",70,0) . S PAYNAM=$P($G(^RCY(344.4,RCERA,0)),U,6) "RTN","RCDPEAD",71,0) . I PAYID'="",PAYNAM'="" D "RTN","RCDPEAD",72,0) . . S RCPARM=$O(^RCY(344.6,"CPID",PAYNAM,PAYID,"")) "RTN","RCDPEAD",73,0) . . S:RCPARM'="" RC3446=$G(^RCY(344.6,RCPARM,0)) "RTN","RCDPEAD",74,0) . ; "RTN","RCDPEAD",75,0) . ; Ignore ERA if EXCLUDE MED CLAIMS POSTING (#.06) or "RTN","RCDPEAD",76,0) . ; EXCLUDE MED CLAIMS DECREASE (#.07) fields set to 'yes' "RTN","RCDPEAD",77,0) . I $G(RC3446)'="" Q:$P(RC3446,U,6)=1 Q:$P(RC3446,U,7)=1 "RTN","RCDPEAD",78,0) . ; "RTN","RCDPEAD",79,0) . ; Build index to scratchpad for this ERA "RTN","RCDPEAD",80,0) . N RCARRAY "RTN","RCDPEAD",81,0) . D BUILD^RCDPEAP(RCERA,.RCARRAY) "RTN","RCDPEAD",82,0) . ; "RTN","RCDPEAD",83,0) . ; Scan ERA DETAIL entries in #344.41 for auto-posted medical claims "RTN","RCDPEAD",84,0) . D EN3(RCDATE,RCERA,.RCARRAY,PAID) ; PRCA*4.5*326 "RTN","RCDPEAD",85,0) Q "RTN","RCDPEAD",86,0) ; "RTN","RCDPEAD",87,0) EN3(RCDATE,RCERA,RCARRAY,PAID) ; Scan ERA DETAIL entries in #344.41 for auto-posted medical claims - PRCA*4.5*326 added PAID "RTN","RCDPEAD",88,0) ; Input: RCDATE - Current date being search "RTN","RCDPEAD",89,0) ; RCERA - ERA number "RTN","RCDPEAD",90,0) ; RCARRAY - Array of ERA Scratchpad lines "RTN","RCDPEAD",91,0) ; PAID - 1 = decrease paid lines, 2 = decrease no-pay lines "RTN","RCDPEAD",92,0) N IENS,RCADJ,RCLINE "RTN","RCDPEAD",93,0) S RCLINE=0 "RTN","RCDPEAD",94,0) ; "RTN","RCDPEAD",95,0) ; Find auto-posted paid lines to auto-decrease "RTN","RCDPEAD",96,0) I PAID=1 D "RTN","RCDPEAD",97,0) .F S RCLINE=$O(^RCY(344.4,"F",RCDATE,RCERA,RCLINE)) Q:'RCLINE D "RTN","RCDPEAD",98,0) ..; Ignore claim line if already auto decreased "RTN","RCDPEAD",99,0) ..Q:$P($G(^RCY(344.4,RCERA,1,RCLINE,5)),U,3) "RTN","RCDPEAD",100,0) ..; Process line "RTN","RCDPEAD",101,0) ..D EN4(RCDATE,RCERA,.RCARRAY,PAID,RCLINE) "RTN","RCDPEAD",102,0) ; "RTN","RCDPEAD",103,0) ; Find zero lines on the auto-posted ERA which are auto-decrease candidates "RTN","RCDPEAD",104,0) I PAID=2 D "RTN","RCDPEAD",105,0) .F S RCLINE=$O(RCARRAY(RCLINE)) Q:'RCLINE D "RTN","RCDPEAD",106,0) ..; Ignore claim line if already auto decreased "RTN","RCDPEAD",107,0) ..Q:$P($G(^RCY(344.4,RCERA,1,RCLINE,5)),U,3) "RTN","RCDPEAD",108,0) ..; Process line "RTN","RCDPEAD",109,0) ..D EN4(RCDATE,RCERA,.RCARRAY,PAID,RCLINE) "RTN","RCDPEAD",110,0) Q "RTN","RCDPEAD",111,0) ; "RTN","RCDPEAD",112,0) EN4(RCDATE,RCERA,RCARRAY,PAID,RCLINE) ; Auto-decrease selected lines "RTN","RCDPEAD",113,0) ; Input: RCDATE - Auto-Post Date "RTN","RCDPEAD",114,0) ; RCERA - IEN of the ERA (#344.4) "RTN","RCDPEAD",115,0) ; RCARRAY - Array of scratch pad lines "RTN","RCDPEAD",116,0) ; PAID - 1 - Decrease paid lines "RTN","RCDPEAD",117,0) ; 2 - Decrease no-pay lines "RTN","RCDPEAD",118,0) ; RCLINE - IEN of the detail ilne in sub-file 344.41 "RTN","RCDPEAD",119,0) ; "RTN","RCDPEAD",120,0) ; Get claim number RCBILL for the ERA line using EOB #361.1 pointer "RTN","RCDPEAD",121,0) ; BEGIN PRCA*4.5*326 "RTN","RCDPEAD",122,0) N COMMENT,EOBIEN,RCBAL,RCBILL,RCMAX,RCTRANDA,RCZERO "RTN","RCDPEAD",123,0) ; Check if this is a zero payment line "RTN","RCDPEAD",124,0) S RCZERO=$S($$GET1^DIQ(344.41,RCLINE_","_RCERA_",",.03)=0:1,1:0) "RTN","RCDPEAD",125,0) ; "RTN","RCDPEAD",126,0) ; Quit if this is a no-payment line and loop is for payment lines "RTN","RCDPEAD",127,0) I PAID=1,RCZERO Q "RTN","RCDPEAD",128,0) ; Quit if this is not a no-payment line and loop is for no-payment lines "RTN","RCDPEAD",129,0) I PAID=2,'RCZERO Q "RTN","RCDPEAD",130,0) ; "RTN","RCDPEAD",131,0) ; Ignore zero amount reversals "RTN","RCDPEAD",132,0) I RCZERO Q:'$G(RCARRAY(RCLINE)) "RTN","RCDPEAD",133,0) ; "RTN","RCDPEAD",134,0) ; Ignore zero lines if status is unverified in scratchpad (#344.491,.13) "RTN","RCDPEAD",135,0) I RCZERO D Q:'$$GET1^DIQ(344.491,IENS,.13,"I") "RTN","RCDPEAD",136,0) . S IENS=$G(RCARRAY(RCLINE))_","_RCERA "RTN","RCDPEAD",137,0) ; END PRCA*4.5*326 "RTN","RCDPEAD",138,0) ; "RTN","RCDPEAD",139,0) ; Get pointer to EOB file #361.1 from ERA DETAIL "RTN","RCDPEAD",140,0) S EOBIEN=$P($G(^RCY(344.4,RCERA,1,RCLINE,0)),U,2),RCBILL=0 "RTN","RCDPEAD",141,0) ; "RTN","RCDPEAD",142,0) ; Get ^DGCR(399 pointer (DINUM for #430 file) "RTN","RCDPEAD",143,0) S:EOBIEN RCBILL=$P($G(^IBM(361.1,EOBIEN,0)),U) Q:'RCBILL "RTN","RCDPEAD",144,0) ; "RTN","RCDPEAD",145,0) ; Skip zero lines if other unposted non-zero amount ERA lines exist for this bill "RTN","RCDPEAD",146,0) ;;I RCZERO,$$OTHER(RCBILL,RCERA) Q ; PRCA*4.4*326 "RTN","RCDPEAD",147,0) ; "RTN","RCDPEAD",148,0) ; If claim has been split/edit and claim changed in APAR do not auto decrease "RTN","RCDPEAD",149,0) Q:$$SPLIT(RCERA,RCLINE,RCBILL,.RCARRAY) "RTN","RCDPEAD",150,0) ; "RTN","RCDPEAD",151,0) ; Do not auto decrease if claim is referred to General Council "RTN","RCDPEAD",152,0) Q:$P($G(^PRCA(430,RCBILL,6)),U,4)]"" "RTN","RCDPEAD",153,0) ; "RTN","RCDPEAD",154,0) ; Claim must be OPEN or ACTIVE "RTN","RCDPEAD",155,0) N STATUS "RTN","RCDPEAD",156,0) S STATUS=$P($G(^PRCA(430,RCBILL,0)),"^",8) "RTN","RCDPEAD",157,0) I STATUS'=42,STATUS'=16 Q "RTN","RCDPEAD",158,0) ; "RTN","RCDPEAD",159,0) S RCAMT=$$CARCLMT(EOBIEN,RCZERO) ; PRCA*4.5*326 - added RCZERO "RTN","RCDPEAD",160,0) Q:$L(RCAMT)=0 ; No CARCs on EOB were eligible for auto-decrease "RTN","RCDPEAD",161,0) ; "RTN","RCDPEAD",162,0) ; Order CARCs for Auto-Decrease in largest to smallest amount order "RTN","RCDPEAD",163,0) K RCIARR "RTN","RCDPEAD",164,0) F J=1:1 S RCITEM=$P(RCAMT,U,J) Q:RCITEM="" S RCIARR(-($P(RCITEM,";",1)),J)=RCITEM "RTN","RCDPEAD",165,0) Q:$D(RCIARR)<10 ; Quit if CARC adjustment array doesn't have any elements to process "RTN","RCDPEAD",166,0) ; "RTN","RCDPEAD",167,0) ; Get top limit for auto-decrease "RTN","RCDPEAD",168,0) S RCMAX=+$$GET1^DIQ(344.61,"1,",.05) "RTN","RCDPEAD",169,0) ; "RTN","RCDPEAD",170,0) ; Walk the RCIARR and apply CARC based adjustments to the bill. "RTN","RCDPEAD",171,0) S RCJ="",RCADJ=0 "RTN","RCDPEAD",172,0) F S RCJ=$O(RCIARR(RCJ)) Q:RCJ="" S RCK="" F S RCK=$O(RCIARR(RCJ,RCK)) Q:RCK="" D "RTN","RCDPEAD",173,0) . ; Get current balance on Bill "RTN","RCDPEAD",174,0) . S RCBAL=$P($G(^PRCA(430,RCBILL,7)),U) "RTN","RCDPEAD",175,0) . ; "RTN","RCDPEAD",176,0) . ; Check pending payment amount and bill balance "RTN","RCDPEAD",177,0) . N PENDING "RTN","RCDPEAD",178,0) . S PENDING=$$PENDPAY^RCDPURET(RCBILL) "RTN","RCDPEAD",179,0) . K ^TMP($J,"RCDPUREC","PP") "RTN","RCDPEAD",180,0) . Q:(RCBAL-PENDING)<(+$P(RCIARR(RCJ,RCK),";",1)) "RTN","RCDPEAD",181,0) . ; "RTN","RCDPEAD",182,0) . Q:(RCADJ+$P(RCIARR(RCJ,RCK),";",1))>RCMAX ; Don't apply decrease if over top limit "RTN","RCDPEAD",183,0) . ; "RTN","RCDPEAD",184,0) . S COMMENT(1)="MEDICAL AUTO-DECREASE FOR CARC: "_$P(RCIARR(RCJ,RCK),";",2)_" AMOUNT: "_+$P(RCIARR(RCJ,RCK),";",1) ; PRCA*&4.5*326 "RTN","RCDPEAD",185,0) . S COMMENT(1)=COMMENT(1)_" (MAX DEC: "_+$P($$ACTCARC($P(RCIARR(RCJ,RCK),";",2),RCZERO),U,2)_")" ; PRCA*4.5*326 "RTN","RCDPEAD",186,0) . ; If this CARC is expired then add that information to the comment "RTN","RCDPEAD",187,0) . I $P(RCIARR(RCJ,RCK),";",3)'="" S COMMENT(1)=COMMENT(1)_" CARC expired on "_$$FMTE^XLFDT($P(RCIARR(RCJ,RCK),";",3),"6D") "RTN","RCDPEAD",188,0) . ; Apply contract adjustment for CARC adjustment amount from claim information "RTN","RCDPEAD",189,0) . S RCTRANDA=$$INCDEC^RCBEUTR1(RCBILL,-$P(RCIARR(RCJ,RCK),";",1),.COMMENT,"","",1) Q:'RCTRANDA "RTN","RCDPEAD",190,0) . ; Update total adjustments for line "RTN","RCDPEAD",191,0) . S RCADJ=RCADJ+$P(RCIARR(RCJ,RCK),";",1) "RTN","RCDPEAD",192,0) ; Update auto-decrease indicator, auto decrease amount and auto decrease date "RTN","RCDPEAD",193,0) N DA,DIE,DR S DA(1)=RCERA,DA=RCLINE,DIE="^RCY(344.4,"_DA(1)_",1,",DR="7///1;8///"_RCADJ_";10///"_DT D ^DIE "RTN","RCDPEAD",194,0) ; Update last auto decrease date on ERA "RTN","RCDPEAD",195,0) N DA,DIE,DR "RTN","RCDPEAD",196,0) S DA=RCERA,DIE="^RCY(344.4,",DR="4.03///"_DT "RTN","RCDPEAD",197,0) ; "RTN","RCDPEAD",198,0) ; PRCA*4.5*332 - If we just did an Auto-Decrease of a zero-dollar ERA set "RTN","RCDPEAD",199,0) ; the Match Status to MATCH - 0 PAYMENT and the Posting Status to POSTING NOT NEEDED "RTN","RCDPEAD",200,0) I PAID=0,RCZERO D "RTN","RCDPEAD",201,0) . S DR=DR_";.09////3;.14////3" "RTN","RCDPEAD",202,0) D ^DIE "RTN","RCDPEAD",203,0) Q "RTN","RCDPEAD",204,0) ; "RTN","RCDPEAD",205,0) REJ ; Process zero balance denial ERA's - PRCA*4.5*326 "RTN","RCDPEAD",206,0) N PAID,PAYID,PAYNAM,RC3446,RCDAY,RCLINE,RCPARM "RTN","RCDPEAD",207,0) ; Get days to wait for payer rejects (rename no-pay lines field) "RTN","RCDPEAD",208,0) S RCDAY=$$FMADD^XLFDT(DT\1,-$$GET1^DIQ(344.61,"1,",.12)) "RTN","RCDPEAD",209,0) ; Scan AFD index for ERA received within date range "RTN","RCDPEAD",210,0) S RCDATE=$$FMADD^XLFDT(RCDAY,-1)_".99999",PAID=0 "RTN","RCDPEAD",211,0) F S RCDATE=$O(^RCY(344.4,"AFD",RCDATE)) Q:'RCDATE Q:(RCDATE\1)>RCDAY D "RTN","RCDPEAD",212,0) . S RCERA=0 "RTN","RCDPEAD",213,0) . ; Check for payer reject ERA's "RTN","RCDPEAD",214,0) . F S RCERA=$O(^RCY(344.4,"AFD",RCDATE,RCERA)) Q:'RCERA D "RTN","RCDPEAD",215,0) .. ; Ignore ERA if total paid is not zero "RTN","RCDPEAD",216,0) .. Q:+$$GET1^DIQ(344.4,RCERA_",",.05) "RTN","RCDPEAD",217,0) .. ; Ignore ERA if removed from worklist "RTN","RCDPEAD",218,0) .. Q:+$$GET1^DIQ(344.4,RCERA_",",.16,"I") "RTN","RCDPEAD",219,0) .. ; Ignore ERA if not payment type of NON "RTN","RCDPEAD",220,0) .. Q:$$GET1^DIQ(344.4,RCERA_",",.15)'="NON" "RTN","RCDPEAD",221,0) .. ; Quit if ERA is for Pharmacy "RTN","RCDPEAD",222,0) .. S RCRTYPE=$$PHARM^RCDPEAP1(RCERA) "RTN","RCDPEAD",223,0) .. Q:RCRTYPE "RTN","RCDPEAD",224,0) .. ; Check payer exclusion file for this ERA's payer "RTN","RCDPEAD",225,0) .. S PAYID=$P($G(^RCY(344.4,RCERA,0)),U,3) "RTN","RCDPEAD",226,0) .. S PAYNAM=$P($G(^RCY(344.4,RCERA,0)),U,6) "RTN","RCDPEAD",227,0) .. I PAYID'="",PAYNAM'="" D "RTN","RCDPEAD",228,0) .. . S RCPARM=$O(^RCY(344.6,"CPID",PAYNAM,PAYID,"")) "RTN","RCDPEAD",229,0) .. . S:RCPARM'="" RC3446=$G(^RCY(344.6,RCPARM,0)) "RTN","RCDPEAD",230,0) .. ; Ignore ERA if EXCLUDE MED CLAIMS POSTING (#.06) or EXCLUDE MED CLAIMS DECREASE (#.07) fields set to 'yes' "RTN","RCDPEAD",231,0) .. I $G(RC3446)'="" Q:$P(RC3446,U,6)=1 Q:$P(RC3446,U,7)=1 "RTN","RCDPEAD",232,0) .. ; Ignore ERA if auto-post blocked "RTN","RCDPEAD",233,0) .. Q:$$GET1^DIQ(344.4,RCERA_",",.19,"I") "RTN","RCDPEAD",234,0) .. ; "RTN","RCDPEAD",235,0) .. ; Build Scratchpad (if needed) and Verify Lines "RTN","RCDPEAD",236,0) .. K ^TMP($J,"RCDPEWLA") "RTN","RCDPEAD",237,0) .. S RCSCR=$$SCRPAD^RCDPEWLZ(RCERA) "RTN","RCDPEAD",238,0) .. I 'RCSCR Q "RTN","RCDPEAD",239,0) .. ; Ignore ERA if it has PLBs "RTN","RCDPEAD",240,0) .. I $D(^TMP($J,"RCDPEWLA","ERA LEVEL ADJUSTMENT EXISTS")) Q "RTN","RCDPEAD",241,0) .. ; "RTN","RCDPEAD",242,0) .. ; Build index to scratchpad for this ERA "RTN","RCDPEAD",243,0) .. N RCARRAY "RTN","RCDPEAD",244,0) .. D BUILD^RCDPEAP(RCERA,.RCARRAY) "RTN","RCDPEAD",245,0) .. ; Search lines "RTN","RCDPEAD",246,0) .. S RCLINE=0 "RTN","RCDPEAD",247,0) .. F S RCLINE=$O(RCARRAY(RCLINE)) Q:'RCLINE D "RTN","RCDPEAD",248,0) ...; Ignore claim line if already auto decreased "RTN","RCDPEAD",249,0) ...Q:$P($G(^RCY(344.4,RCERA,1,RCLINE,5)),U,3) "RTN","RCDPEAD",250,0) ...; Process line "RTN","RCDPEAD",251,0) ...D EN4(RCDATE,RCERA,.RCARRAY,PAID,RCLINE) "RTN","RCDPEAD",252,0) Q "RTN","RCDPEAD",253,0) ; "RTN","RCDPEAD",254,0) SPLIT(RCSCR,RCLINE,RCBILL,RCARRAY) ;Check for SPLIT/EDIT in scratchpad "RTN","RCDPEAD",255,0) ;Input RCSCR - IEN of #344.49 "RTN","RCDPEAD",256,0) ; RCLINE - ERA detail line sequence number "RTN","RCDPEAD",257,0) ; RCBILL - IEN of #430 "RTN","RCDPEAD",258,0) ; ARRAY - reference to passed array (from BUILD^RCDPEAP) "RTN","RCDPEAD",259,0) ;Output return value 1/0 = Split/Not Split "RTN","RCDPEAD",260,0) N SUB,SUB1 "RTN","RCDPEAD",261,0) ;Find ERA line in scratchpad "RTN","RCDPEAD",262,0) S SUB=$G(RCARRAY(RCLINE)) Q:'SUB 0 "RTN","RCDPEAD",263,0) ;Get n.001 line "RTN","RCDPEAD",264,0) S SUB1=$O(^RCY(344.49,RCSCR,1,SUB)) Q:'SUB1 0 "RTN","RCDPEAD",265,0) ;Check sequence number is the same "RTN","RCDPEAD",266,0) Q:$P($G(^RCY(344.49,RCSCR,1,SUB1,0)),".")'=$P($G(^RCY(344.49,RCSCR,1,SUB,0)),U) 0 "RTN","RCDPEAD",267,0) ;Check that claim number is unchanged from original ERA "RTN","RCDPEAD",268,0) Q:$P($G(^RCY(344.49,RCSCR,1,SUB1,0)),U,7)=RCBILL 0 "RTN","RCDPEAD",269,0) ;Otherwise claim was edited (and should not be decreased) "RTN","RCDPEAD",270,0) Q 1 "RTN","RCDPEAD",271,0) ; "RTN","RCDPEAD",272,0) CARCLMT(RCEOB,RCZERO,FROMADP,ADATE) ;EP from COMPILE^RCDPEADP "RTN","RCDPEAD",273,0) ; PRCA*4.5*304 - Check to see if CARC are included and are eligible "RTN","RCDPEAD",274,0) ; for auto-decrease. Return 0 if not, Max Amount ^ CARC if it is. "RTN","RCDPEAD",275,0) ; Input: RCEOB - Internal IEN for the explanation of benefits field (361.1) "RTN","RCDPEAD",276,0) ; FROMADP - 1 if being called from COMPILE^RCDPEADP, 0 otherwise "RTN","RCDPEAD",277,0) ; Optional, default to 0 "RTN","RCDPEAD",278,0) ; ADATE - Internal Auto-Post Date (only passed if FROMADP=1) "RTN","RCDPEAD",279,0) ; RCZERO - 0 = ERA Line with payment 1 = ERA Line without payment "RTN","RCDPEAD",280,0) ; Returns: A1;A2;A3;A4^B1;B2;B3;B4^...^N1;N2;N3;N4 Where: "RTN","RCDPEAD",281,0) ; A1 - Auto-Decrease amount of the 1st CARC code in the EOB "RTN","RCDPEAD",282,0) ; A2 - 1st CARC code in the EOB "RTN","RCDPEAD",283,0) ; A3 - Deactivation Date of the 1st CARC code in the EOB if "RTN","RCDPEAD",284,0) ; it has one and is less than today AND FROMADP=0 "RTN","RCDPEAD",285,0) ; Otherwise Quantity of the first CARC code in the EOB if "RTN","RCDPEAD",286,0) ; FROMADP=1 "RTN","RCDPEAD",287,0) ; A4 - Reason of the 1st CARC code in the EOB "RTN","RCDPEAD",288,0) ; only passed if FROMADP=1 "RTN","RCDPEAD",289,0) N I,RCAMT,RCCAMT,RCCODE,RCCODES,RCDATA,RCITEM,RCTAMT,XDT,XIEN "RTN","RCDPEAD",290,0) S:'$D(FROMADP) FROMADP=0 "RTN","RCDPEAD",291,0) S RCAMT="",RCCODES="" "RTN","RCDPEAD",292,0) ; "RTN","RCDPEAD",293,0) ; Extract the CARC codes from the EOB. "RTN","RCDPEAD",294,0) ; Returned are ^A1;A2;A3;A4^A1;A2;A3;A4^... Where "RTN","RCDPEAD",295,0) ; A1 - CARC code "RTN","RCDPEAD",296,0) ; A2 - Auto Decrease Amount "RTN","RCDPEAD",297,0) ; A3 - Quantity (only returned if FROMADP=1) "RTN","RCDPEAD",298,0) ; A4 - REASON (only returned if FROMADP=1) "RTN","RCDPEAD",299,0) D GETCARCS(RCEOB,.RCCODES,FROMADP) "RTN","RCDPEAD",300,0) ; "RTN","RCDPEAD",301,0) ; Loop through all of the CARC codes found. If none, it will exit. "RTN","RCDPEAD",302,0) F I=2:1:$L(RCCODES,"^") D "RTN","RCDPEAD",303,0) . S RCITEM=$P(RCCODES,"^",I) "RTN","RCDPEAD",304,0) . Q:RCITEM="" "RTN","RCDPEAD",305,0) . S RCCODE=$P(RCITEM,";",1),RCCAMT=$P(RCITEM,";",2) "RTN","RCDPEAD",306,0) . ; "RTN","RCDPEAD",307,0) . ; Quit If the Adjustment amount is a negative amount "RTN","RCDPEAD",308,0) . Q:+RCCAMT<0 "RTN","RCDPEAD",309,0) . ; "RTN","RCDPEAD",310,0) . ; Look up code in CARC table and get max adjustment "RTN","RCDPEAD",311,0) . S RCDATA=$$ACTCARC(RCCODE,RCZERO) ; PRCA*4.5*326 "RTN","RCDPEAD",312,0) . ; "RTN","RCDPEAD",313,0) . ; Quit If auto decrease is not active on this code "RTN","RCDPEAD",314,0) . Q:+RCDATA=0 "RTN","RCDPEAD",315,0) . ; "RTN","RCDPEAD",316,0) . ; Get code inactive date if it exists "RTN","RCDPEAD",317,0) . S XIEN=$$FIND1^DIC(345,,"O",RCCODE) "RTN","RCDPEAD",318,0) . S:$G(XIEN)'="" XDT=$$GET1^DIQ(345,XIEN_",",2,"I") "RTN","RCDPEAD",319,0) . I $G(XDT)'="" S:XDT'
30 REASON=$E(REASON,1,27)_"..." "RTN","RCDPEAD",367,0) . . S RCCODES=RCCODES_"^"_RCCODE_";"_RCAMT_";"_QUANT_";"_REASON "RTN","RCDPEAD",368,0) ; "RTN","RCDPEAD",369,0) ; Get Claim Line level CARCs "RTN","RCDPEAD",370,0) S RCL=0 "RTN","RCDPEAD",371,0) F D Q:+RCL=0 "RTN","RCDPEAD",372,0) . S RCL=$O(^IBM(361.1,RCEOB,15,RCL)) "RTN","RCDPEAD",373,0) . Q:+RCL=0 "RTN","RCDPEAD",374,0) . S RCI=0 "RTN","RCDPEAD",375,0) . F D Q:+RCI=0 "RTN","RCDPEAD",376,0) . . S RCI=$O(^IBM(361.1,RCEOB,15,RCL,1,RCI)) "RTN","RCDPEAD",377,0) . . Q:+RCI=0 "RTN","RCDPEAD",378,0) . . S RCJ=0 "RTN","RCDPEAD",379,0) . . F D Q:+RCJ=0 "RTN","RCDPEAD",380,0) . . . S RCJ=$O(^IBM(361.1,RCEOB,15,RCL,1,RCI,1,RCJ)) "RTN","RCDPEAD",381,0) . . . Q:+RCJ=0 "RTN","RCDPEAD",382,0) . . . S IENS=RCJ_","_RCI_","_RCL_","_RCEOB_"," "RTN","RCDPEAD",383,0) . . . S RCCODE=$$GET1^DIQ(361.11511,IENS,.01,"I") ; CARC Code "RTN","RCDPEAD",384,0) . . . Q:RCCODE="" "RTN","RCDPEAD",385,0) . . . S RCAMT=$$GET1^DIQ(361.11511,IENS,.02,"I") ; CARC Amount "RTN","RCDPEAD",386,0) . . . I 'FROMADP S RCCODES=RCCODES_"^"_RCCODE_";"_RCAMT Q "RTN","RCDPEAD",387,0) . . . S QUANT=$$GET1^DIQ(361.11511,IENS,.03,"I") ; CARC Quantity "RTN","RCDPEAD",388,0) . . . S REASON=$$GET1^DIQ(361.11511,IENS,.04,"I") ; CARC Reason "RTN","RCDPEAD",389,0) . . . S:$L(REASON)>30 REASON=$E(REASON,1,27)_"..." "RTN","RCDPEAD",390,0) . . . S RCCODES=RCCODES_"^"_RCCODE_";"_RCAMT_";"_QUANT_";"_REASON "RTN","RCDPEAD",391,0) Q "RTN","RCDPEAD",392,0) ; "RTN","RCDPEAD",393,0) ; PRCA*4.5*304 - Added function "RTN","RCDPEAD",394,0) ACTCARC(CODE,RCZERO) ; Is this CARC an active code for auto-decrease "RTN","RCDPEAD",395,0) ; Input: CODE - CARC code being checked "RTN","RCDPEAD",396,0) ; RCZERO - O = Claim line with payment, 1 = Claim line with no payment "RTN","RCDPEAD",397,0) ; Returns: '0^NOT ACTIVE' if not active "RTN","RCDPEAD",398,0) ; '1^{amount}' if active and the second piece is the decrease amount "RTN","RCDPEAD",399,0) N AIEN,FIELD,XX "RTN","RCDPEAD",400,0) I $G(CODE)="" Q "0^NOT ACTIVE" "RTN","RCDPEAD",401,0) S AIEN=$O(^RCY(344.62,"B",CODE,"")) "RTN","RCDPEAD",402,0) I AIEN="" Q "0^NOT ACTIVE" "RTN","RCDPEAD",403,0) ; BEGIN PRCA*4.5*326 "RTN","RCDPEAD",404,0) S FIELD=$S(RCZERO:.08,1:.02) ; No pay line CARCs have separate on/off switch "RTN","RCDPEAD",405,0) S XX=$$GET1^DIQ(344.62,AIEN,FIELD,"I") ; Quit if auto-decrease is off "RTN","RCDPEAD",406,0) S FIELD=$S(RCZERO:.12,1:.06) ; No pay line CARCs have different maximum "RTN","RCDPEAD",407,0) I XX=1 Q "1^"_$$GET1^DIQ(344.62,AIEN,FIELD) ; Active code returns maximum allowed decrease amount "RTN","RCDPEAD",408,0) ; END PRCA*4.5*326 "RTN","RCDPEAD",409,0) Q "0^NOT ACTIVE" "RTN","RCDPEAD",410,0) ; "RTN","RCDPEAD",411,0) OTHER(RCBILLDA,ORIG) ; Check if APAR/WL entries exist on other ERA for this bill "RTN","RCDPEAD",412,0) ; INPUT "RTN","RCDPEAD",413,0) ; RCBILLDA - IEN for claim in #430 or #399 "RTN","RCDPEAD",414,0) ; ORIG - IEN for current ERA "RTN","RCDPEAD",415,0) ; OUTPUT "RTN","RCDPEAD",416,0) ; RCPEND - 1 = Other ERA payments exist 0 - No other ERA payments exit "RTN","RCDPEAD",417,0) ; "RTN","RCDPEAD",418,0) N AUTOSTA,RCERA,RCEOB,RCLINE,RCPAID,RCPEND,RCTOT,RCZ,RCZL "RTN","RCDPEAD",419,0) ; Find EEOB's for this claim "RTN","RCDPEAD",420,0) S RCEOB=0,RCPEND=0 "RTN","RCDPEAD",421,0) F S RCEOB=$O(^IBM(361.1,"B",RCBILLDA,RCEOB)) Q:'RCEOB Q:RCPEND D "RTN","RCDPEAD",422,0) . ;Find ERAs for this EOB - may be multiple "RTN","RCDPEAD",423,0) . S RCERA=0 "RTN","RCDPEAD",424,0) . F S RCERA=$O(^RCY(344.4,"ADET",RCEOB,RCERA)) Q:'RCERA Q:RCPEND D "RTN","RCDPEAD",425,0) . . ; Ignore original ERA "RTN","RCDPEAD",426,0) . . Q:RCERA=ORIG "RTN","RCDPEAD",427,0) . . ; Get auto-post status for ERA "RTN","RCDPEAD",428,0) . . S AUTOSTA=$$GET1^DIQ(344.4,RCERA_",",4.02,"I") "RTN","RCDPEAD",429,0) . . ; Ignore completely processed auto-post ERA "RTN","RCDPEAD",430,0) . . Q:AUTOSTA=2 "RTN","RCDPEAD",431,0) . . ; Ignore non-auto-post ERA which already have a receipt - processed or otherwise "RTN","RCDPEAD",432,0) . . I AUTOSTA="",$$GET1^DIQ(344.4,RCERA_",",.08,"I") Q "RTN","RCDPEAD",433,0) . . ; Get ERA lines for this EOB "RTN","RCDPEAD",434,0) . . S RCLINE=0,RCTOT=0 "RTN","RCDPEAD",435,0) . . F S RCLINE=$O(^RCY(344.4,"ADET",RCEOB,RCERA,RCLINE)) Q:'RCLINE Q:RCPEND D "RTN","RCDPEAD",436,0) . . . ; Ignore auto-posted lines (which have a receipt) "RTN","RCDPEAD",437,0) . . . I AUTOSTA]"",$$GET1^DIQ(344.41,RCLINE_","_RCERA_",",.25) Q "RTN","RCDPEAD",438,0) . . . ; Get paid amount from ERA line "RTN","RCDPEAD",439,0) . . . S RCPAID=$$GET1^DIQ(344.41,RCLINE_","_RCERA_",",.03) "RTN","RCDPEAD",440,0) . . . ; Ignore zero lines "RTN","RCDPEAD",441,0) . . . Q:'RCPAID "RTN","RCDPEAD",442,0) . . . ; If no scratchpad use paid amount from ERA "RTN","RCDPEAD",443,0) . . . I '$D(^RCY(344.49,RCERA)) S RCTOT=RCTOT+RCPAID Q "RTN","RCDPEAD",444,0) . . . ; Find ERA line in scratchpad "RTN","RCDPEAD",445,0) . . . S RCZL=$$FIND(RCERA,RCLINE) Q:'RCZL "RTN","RCDPEAD",446,0) . . . ; If scratchpad exists scan B index for split lines(344.49 is DINUM with 344.4) "RTN","RCDPEAD",447,0) . . . S RCSUB=RCZL "RTN","RCDPEAD",448,0) . . . F S RCSUB=$O(^RCY(344.49,RCERA,1,"B",RCSUB)) Q:(RCSUB\1)'=RCZL D "RTN","RCDPEAD",449,0) . . . . S RCZ=$O(^RCY(344.49,RCERA,1,"B",RCSUB,"")) Q:'RCZ "RTN","RCDPEAD",450,0) . . . . ; Check AR BILL is for this claim "RTN","RCDPEAD",451,0) . . . . Q:$$GET1^DIQ(344.491,RCZ_","_RCERA_",",.07,"I")'=RCBILLDA "RTN","RCDPEAD",452,0) . . . . ; Add AMOUNT TO POST ON RECEIPT to pending total - should resolve reversals "RTN","RCDPEAD",453,0) . . . . S RCTOT=RCTOT+$$GET1^DIQ(344.491,RCZ_","_RCERA_",",.03) "RTN","RCDPEAD",454,0) . . ; If claim total for the ERA is non-zero auto-decrease is blocked "RTN","RCDPEAD",455,0) . . S:RCTOT>0 RCPEND=1 "RTN","RCDPEAD",456,0) Q RCPEND "RTN","RCDPEAD",457,0) ; "RTN","RCDPEAD",458,0) FIND(RCERA,RCLINE) ; Search ORIGINAL ERA SEQUENCES for this line "RTN","RCDPEAD",459,0) ; Input RCERA - Scratchpad IEN "RTN","RCDPEAD",460,0) ; RCLINE - ERA line to find "RTN","RCDPEAD",461,0) ; Output RET - Scratchpad line number "RTN","RCDPEAD",462,0) ; "RTN","RCDPEAD",463,0) N DA,ORIG,RCSUB,RET "RTN","RCDPEAD",464,0) S RCSUB=0,RET=0 "RTN","RCDPEAD",465,0) F S RCSUB=$O(^RCY(344.49,RCERA,1,"ASEQ",RCSUB)) Q:RET Q:'RCSUB D "RTN","RCDPEAD",466,0) . S DA=$O(^RCY(344.49,RCERA,1,"ASEQ",RCSUB,"")) Q:'DA "RTN","RCDPEAD",467,0) . ;Get Original sequences "RTN","RCDPEAD",468,0) . S ORIG=$$GET1^DIQ(344.491,DA_","_RCERA_",",.09) Q:ORIG="" "RTN","RCDPEAD",469,0) . ;Check if scratchpad line is for original ERA line "RTN","RCDPEAD",470,0) . S ORIG=","_ORIG_"," "RTN","RCDPEAD",471,0) . S:$F(ORIG,","_RCLINE_",") RET=RCSUB "RTN","RCDPEAD",472,0) Q RET "RTN","RCDPEARL") 0^14^B41725584 "RTN","RCDPEARL",1,0) RCDPEARL ;ALB/hrubovcak - Misc. Report utilities for ListMan, etc. ;Jun 06, 2014@19:11:19 "RTN","RCDPEARL",2,0) ;;4.5;Accounts Receivable;**298,321,332**;15 April 2014;Build 40 "RTN","RCDPEARL",3,0) ;Per VA Directive 6402, this routine should not be modified. "RTN","RCDPEARL",4,0) ; "RTN","RCDPEARL",5,0) ; IA 594 - ACCOUNTS RECEIVABLE CATEGORY file (#430.2) "RTN","RCDPEARL",6,0) ; IA 1992 - BILL/CLAIMS file (#399) "RTN","RCDPEARL",7,0) ; IA 3822 - RATE TYPE file (#399.3) "RTN","RCDPEARL",8,0) ; IA 4051 - EXPLANATION OF BENEFITS file (#361.1) "RTN","RCDPEARL",9,0) ; "RTN","RCDPEARL",10,0) Q "RTN","RCDPEARL",11,0) ; "RTN","RCDPEARL",12,0) ASK(STOP) ; Ask to continue "RTN","RCDPEARL",13,0) ; STOP passed by ref., returned as 1 if timeout or user enters '^' "RTN","RCDPEARL",14,0) Q:'($E(IOST,1,2)="C-") ; must have user "RTN","RCDPEARL",15,0) N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y "RTN","RCDPEARL",16,0) S DIR("A")="Press enter to continue, '^' to exit: " "RTN","RCDPEARL",17,0) S DIR(0)="EA" D ^DIR "RTN","RCDPEARL",18,0) I ($D(DTOUT))!($D(DUOUT))!(Y="^") S STOP=1 "RTN","RCDPEARL",19,0) Q "RTN","RCDPEARL",20,0) ; "RTN","RCDPEARL",21,0) ASKLM(DEFAULT) ; Extrinsic function, ask for ListMan display using ^DIR "RTN","RCDPEARL",22,0) ; Input: DEFAULT - 1 - Default 'YES', 0 - Default 'NO' "RTN","RCDPEARL",23,0) ; Optional defaults to 0 "RTN","RCDPEARL",24,0) ; Returns: 0 - No, 1 - YES, -1 on timeout or '^' "RTN","RCDPEARL",25,0) N DIR,RSLT,X,Y "RTN","RCDPEARL",26,0) S:'$D(DEFAULT) DEFAULT=0 ; PRCA*4.5*332 "RTN","RCDPEARL",27,0) S RSLT=0 "RTN","RCDPEARL",28,0) S DIR(0)="YA",DIR("A")="Display in List Manager format? (Y/N): " "RTN","RCDPEARL",29,0) S DIR("B")=$S(DEFAULT:"YES",1:"NO") ; PRCA*4.5*332 "RTN","RCDPEARL",30,0) D ^DIR S RSLT=$S($D(DUOUT)!$D(DTOUT):-1,1:Y) "RTN","RCDPEARL",31,0) Q RSLT "RTN","RCDPEARL",32,0) ; "RTN","RCDPEARL",33,0) CLMCHMPV(RCLMIEN) ; boolean function, returns true if CHAMPVA claim, else false "RTN","RCDPEARL",34,0) ; RCLMIEN - file entry, format: 'file #;ien' (see PTR4302 comments) "RTN","RCDPEARL",35,0) Q $$EVALCLM(RCLMIEN,"CHAMPVA") "RTN","RCDPEARL",36,0) ; "RTN","RCDPEARL",37,0) CLMTRICR(RCLMIEN) ; boolean function, returns true if TRICARE claim, else false "RTN","RCDPEARL",38,0) ; RCLMIEN - file entry, format: 'file #;ien' (see PTR4302 comments) "RTN","RCDPEARL",39,0) Q $$EVALCLM(RCLMIEN,"TRICARE") "RTN","RCDPEARL",40,0) ; "RTN","RCDPEARL",41,0) ENDORPRT() ; extrinsic variable, formatted for 80 column display "RTN","RCDPEARL",42,0) N A S A="***** END OF REPORT *****" Q $J(" ",80-$L(A)\2)_A "RTN","RCDPEARL",43,0) ; "RTN","RCDPEARL",44,0) EVALCLM(RCLMIEN,TRGTXT) ; boolean function, case insensitive "RTN","RCDPEARL",45,0) ; returns 1 if claim has target text, else false (error messages evaluate as false) "RTN","RCDPEARL",46,0) ; RCLMIEN (required) - file entry, format: 'file #;ien' (see PTR4302 comments) "RTN","RCDPEARL",47,0) ; TRGTXT (required) - target text "RTN","RCDPEARL",48,0) Q:($G(RCLMIEN)="")!($G(TRGTXT)="") "^invalid" ; both required "RTN","RCDPEARL",49,0) N RSLT,F,R,T "RTN","RCDPEARL",50,0) S T=$$UP(TRGTXT),RSLT=0 ; text to uppercase, default to false "RTN","RCDPEARL",51,0) S F=$G(RCLMIEN) Q:'($P(F,";")>1)!'($P(F,";",2)>0) RSLT ; file must be > 1 and entry > zero "RTN","RCDPEARL",52,0) S R=$$PTR4302(RCLMIEN) Q:'R RSLT ; no text to check "RTN","RCDPEARL",53,0) ; "RTN","RCDPEARL",54,0) S F=$$UP($P(R,";",2,99)) ; text of entry from ACCOUNTS RECEIVABLE CATEGORY (#430.2) "RTN","RCDPEARL",55,0) S RSLT=F[T ; boolean result "RTN","RCDPEARL",56,0) Q RSLT "RTN","RCDPEARL",57,0) ; "RTN","RCDPEARL",58,0) INCHMPVA() ; function, include CHAMPVA question "RTN","RCDPEARL",59,0) ; returns zero = No, 1 = yes, -1 on timeout or '^' "RTN","RCDPEARL",60,0) N DIR,DTOUT,DUOUT,RSLT,X,Y S RSLT=0 "RTN","RCDPEARL",61,0) S DIR(0)="YA",DIR("A")="Include CHAMPVA? (Y/N): ",DIR("B")="YES" "RTN","RCDPEARL",62,0) S DIR("?")="Enter 'NO' to exclude entries related to CHAMPVA from the report." "RTN","RCDPEARL",63,0) D ^DIR S RSLT=$S($D(DUOUT)!$D(DTOUT):-1,1:Y) "RTN","RCDPEARL",64,0) Q RSLT "RTN","RCDPEARL",65,0) ; "RTN","RCDPEARL",66,0) INTRICAR() ; function, include TRICARE question "RTN","RCDPEARL",67,0) ; returns zero = No, 1 = yes, -1 on timeout or '^' "RTN","RCDPEARL",68,0) N DIR,DTOUT,DUOUT,RSLT,X,Y S RSLT=0 "RTN","RCDPEARL",69,0) S DIR(0)="YA",DIR("A")="Include TRICARE? (Y/N): ",DIR("B")="YES" "RTN","RCDPEARL",70,0) S DIR("?")="Enter 'NO' to exclude entries related to TRICARE from the report." "RTN","RCDPEARL",71,0) D ^DIR S RSLT=$S($D(DUOUT)!$D(DTOUT):-1,1:Y) "RTN","RCDPEARL",72,0) Q RSLT "RTN","RCDPEARL",73,0) ; Begin PRCA*4.5*321 "RTN","RCDPEARL",74,0) ; "RTN","RCDPEARL",75,0) EXCHMPVA() ; function, exclude CHAMPVA question - EP RCDPEM4 "RTN","RCDPEARL",76,0) ; returns zero = No, 1 = yes, -1 on timeout or '^' "RTN","RCDPEARL",77,0) N DIR,DTOUT,DUOUT,RSLT,X,Y S RSLT=0 "RTN","RCDPEARL",78,0) S DIR(0)="YA",DIR("A")="Exclude CHAMPVA? (Y/N): ",DIR("B")="NO" "RTN","RCDPEARL",79,0) S DIR("?")="Enter 'Y' to exclude entries related to CHAMPVA from the report." "RTN","RCDPEARL",80,0) D ^DIR S RSLT=$S($D(DUOUT)!$D(DTOUT):-1,1:Y) "RTN","RCDPEARL",81,0) Q RSLT "RTN","RCDPEARL",82,0) ; "RTN","RCDPEARL",83,0) EXTRICAR() ; function, exclude TRICARE question - EP RCDPEM4 "RTN","RCDPEARL",84,0) ; returns zero = No, 1 = yes, -1 on timeout or '^' "RTN","RCDPEARL",85,0) N DIR,DTOUT,DUOUT,RSLT,X,Y S RSLT=0 "RTN","RCDPEARL",86,0) S DIR(0)="YA",DIR("A")="Exclude TRICARE? (Y/N): ",DIR("B")="NO" "RTN","RCDPEARL",87,0) S DIR("?")="Enter 'Y' to exclude entries related to TRICARE from the report." "RTN","RCDPEARL",88,0) D ^DIR S RSLT=$S($D(DUOUT)!$D(DTOUT):-1,1:Y) "RTN","RCDPEARL",89,0) Q RSLT "RTN","RCDPEARL",90,0) ; End PRCA*4.5*321 "RTN","RCDPEARL",91,0) ; "RTN","RCDPEARL",92,0) HDRLST(RCSTOP,RCHDR) ; write the header in RCHDR "RTN","RCDPEARL",93,0) ; RCSTOP, RCHDR passed by ref. "RTN","RCDPEARL",94,0) Q:RCSTOP ; nothing to do "RTN","RCDPEARL",95,0) ; "RTN","RCDPEARL",96,0) I $E(IOST,1,2)="C-",'RCDISPTY,RCPGNUM D ASK(.RCSTOP) "RTN","RCDPEARL",97,0) Q:RCSTOP ; no header needed "RTN","RCDPEARL",98,0) I 'RCDISPTY W @IOF "RTN","RCDPEARL",99,0) X RCHDR("XECUTE") ; increment page count, insert into header "RTN","RCDPEARL",100,0) N J F J=1:1:RCHDR(0) W !,RCHDR(J) "RTN","RCDPEARL",101,0) Q "RTN","RCDPEARL",102,0) ; "RTN","RCDPEARL",103,0) LMEN(LMTMP) ; Invoke ListMan for RCDPE MISC REPORTS list template "RTN","RCDPEARL",104,0) ; Input: LMTMP - Name of a different listman template to use "RTN","RCDPEARL",105,0) ; Optional, defaults to "" "RTN","RCDPEARL",106,0) N XX "RTN","RCDPEARL",107,0) S XX=$S($G(LMTMP)'="":LMTMP,1:"RCDPE MISC REPORTS") ; PRCA*4.5*332 "RTN","RCDPEARL",108,0) D EN^VALM(XX) ; PRCA*4.5*332 "RTN","RCDPEARL",109,0) Q "RTN","RCDPEARL",110,0) ; "RTN","RCDPEARL",111,0) LMHDR ; ListMan header "RTN","RCDPEARL",112,0) N J S J=0 "RTN","RCDPEARL",113,0) F J=1:1 Q:'$D(RCLMHDR(J)) S VALMHDR(J)=RCLMHDR(J) "RTN","RCDPEARL",114,0) S:$G(RCLMHDR("TITLE"))'="" VALM("TITLE")=RCLMHDR("TITLE") "RTN","RCDPEARL",115,0) Q "RTN","RCDPEARL",116,0) ; "RTN","RCDPEARL",117,0) LMINIT ; set up ListMan array, invoked from inside List Template "RTN","RCDPEARL",118,0) ; "RTN","RCDPEARL",119,0) N C,J,Y S (J,C)=0 "RTN","RCDPEARL",120,0) F S J=$O(@RCLMND@(J)) Q:'J S Y=$G(@RCLMND@(J)),C=C+1 D SET^VALM10(C,Y) "RTN","RCDPEARL",121,0) S VALMCNT=C "RTN","RCDPEARL",122,0) Q "RTN","RCDPEARL",123,0) ; "RTN","RCDPEARL",124,0) LMHLP ; ListMan help "RTN","RCDPEARL",125,0) S X="?" D DISP^XQORM1 W !! "RTN","RCDPEARL",126,0) Q "RTN","RCDPEARL",127,0) ; "RTN","RCDPEARL",128,0) LMEXIT ; performed on exiting ListMan screen "RTN","RCDPEARL",129,0) K @RCLMND ; delete ListMan data "RTN","RCDPEARL",130,0) D FULL^VALM1 ; reset terminal display "RTN","RCDPEARL",131,0) Q "RTN","RCDPEARL",132,0) ; "RTN","RCDPEARL",133,0) LMEXPND ; expand code for ListMan "RTN","RCDPEARL",134,0) Q "RTN","RCDPEARL",135,0) ; "RTN","RCDPEARL",136,0) LMRPT(RCLMHDR,RCLMND,LMTMP) ; Generate ListMan display "RTN","RCDPEARL",137,0) ; Input: RCLMHDR - Header text, passed by ref. (required) "RTN","RCDPEARL",138,0) ; RCLMND - Storage node for ListMan data (required) "RTN","RCDPEARL",139,0) ; LMTMP - Name of a listman template to use "RTN","RCDPEARL",140,0) ; Optional, defaults to "" "RTN","RCDPEARL",141,0) Q:'$D(RCLMHDR) Q:($G(RCLMND)="") ; both required "RTN","RCDPEARL",142,0) S:'$D(LMTMP) LMTMP="" ; PRCA*4.5*332 "RTN","RCDPEARL",143,0) D LMEN(LMTMP) ; PRCA*4.5*332 "RTN","RCDPEARL",144,0) Q "RTN","RCDPEARL",145,0) ; "RTN","RCDPEARL",146,0) NOW() Q $$FMTE^XLFDT($$NOW^XLFDT,2) ; extrinsic variable, now as MM/DD/YY@HH:MM:SS "RTN","RCDPEARL",147,0) ; "RTN","RCDPEARL",148,0) PAD(TXT,LNGTH) ; function, pad TXT with spaces to LNGTH "RTN","RCDPEARL",149,0) Q $$LJ^XLFSTR(TXT,LNGTH) "RTN","RCDPEARL",150,0) ; "RTN","RCDPEARL",151,0) PTR4302(FLNTRY) ; function, returns entry from 430.2 or error message "RTN","RCDPEARL",152,0) ; FLNTRY - file entry (required), format: 'file #;ien' "RTN","RCDPEARL",153,0) ; on success returns 'ien^name' else '^error message' "RTN","RCDPEARL",154,0) ; file number and ien can be from: "RTN","RCDPEARL",155,0) ; ^PRCA(430.2,0) = ACCOUNTS RECEIVABLE CATEGORY^430.2I "RTN","RCDPEARL",156,0) ; ^DGCR(399.3,0) = RATE TYPE^399.3I^ "RTN","RCDPEARL",157,0) ; ^DGCR(399,0) = BILL/CLAIMS^399I "RTN","RCDPEARL",158,0) ; ^IBM(361.1,0) = EXPLANATION OF BENEFITS^361.1PI^ "RTN","RCDPEARL",159,0) ; ^RCY(344.4,0) = ELECTRONIC REMITTANCE ADVICE^344.4I "RTN","RCDPEARL",160,0) ; ^RCY(344,0) = AR BATCH PAYMENT^344I "RTN","RCDPEARL",161,0) ; "RTN","RCDPEARL",162,0) N F,PF,RCFLNUM,RCIEN,RSLT,X,Y "RTN","RCDPEARL",163,0) ; PF - parent file "RTN","RCDPEARL",164,0) ; RCFLNUM - file number "RTN","RCDPEARL",165,0) ; RCIEN - internal entry number "RTN","RCDPEARL",166,0) ; RSLT - result "RTN","RCDPEARL",167,0) ; "RTN","RCDPEARL",168,0) S RSLT=U,F=$G(FLNTRY),RCFLNUM=+$P(F,";"),RCIEN=+$P(F,";",2) "RTN","RCDPEARL",169,0) Q:'(RCFLNUM>1) U_"invalid file #" "RTN","RCDPEARL",170,0) Q:'(RCIEN>0) U_"invalid IEN" "RTN","RCDPEARL",171,0) ; "RTN","RCDPEARL",172,0) ; default result "RTN","RCDPEARL",173,0) S RSLT="^file "_RCFLNUM_" no entry #"_RCIEN "RTN","RCDPEARL",174,0) ; "RTN","RCDPEARL",175,0) ; ACCOUNTS RECEIVABLE CATEGORY file #430.2 "RTN","RCDPEARL",176,0) I RCFLNUM=430.2 D Q RSLT "RTN","RCDPEARL",177,0) .S X=$G(^PRCA(430.2,RCIEN,0)),Y=$P(X,U) S:Y]"" RSLT=RCIEN_";"_Y "RTN","RCDPEARL",178,0) ; "RTN","RCDPEARL",179,0) ; RATE TYPE file #399.3, (#.06) ACCOUNTS RECEIVABLE CATEGORY [6P:430.2] "RTN","RCDPEARL",180,0) I RCFLNUM=399.3 D Q RSLT "RTN","RCDPEARL",181,0) .S X=$G(^DGCR(399.3,RCIEN,0)),Y=+$P(X,U,6) Q:'(Y>0) "RTN","RCDPEARL",182,0) .S RSLT=$$PTR4302("430.2;"_Y) "RTN","RCDPEARL",183,0) ; "RTN","RCDPEARL",184,0) ; BILL/CLAIMS file #399, (#.07) RATE TYPE [7P:399.3] "RTN","RCDPEARL",185,0) I RCFLNUM=399 D Q RSLT "RTN","RCDPEARL",186,0) .S X=$G(^DGCR(399,RCIEN,0)) Q:X="" "RTN","RCDPEARL",187,0) .S PF=399.3,RSLT="^no pointer to "_PF,Y=+$P(X,U,7) Q:'(Y>0) "RTN","RCDPEARL",188,0) .S RSLT=$$PTR4302(PF_";"_Y) "RTN","RCDPEARL",189,0) ; "RTN","RCDPEARL",190,0) ; EXPLANATION OF BENEFITS file #361.1, (#.01) BILL [1P:399] "RTN","RCDPEARL",191,0) I RCFLNUM=361.1 D Q RSLT "RTN","RCDPEARL",192,0) .S X=$G(^IBM(361.1,RCIEN,0)) Q:X="" "RTN","RCDPEARL",193,0) .S PF=399,RSLT="^no pointer to "_PF,Y=+$P(X,U) Q:'(Y>0) "RTN","RCDPEARL",194,0) .S RSLT=$$PTR4302(PF_";"_Y) "RTN","RCDPEARL",195,0) ; "RTN","RCDPEARL",196,0) ; ELECTRONIC REMITTANCE ADVICE file #344.4 "RTN","RCDPEARL",197,0) ; ERA DETAIL sub-file #344.41, (#.02) EOB DETAIL [2P:361.1] "RTN","RCDPEARL",198,0) I RCFLNUM=344.4 D Q RSLT "RTN","RCDPEARL",199,0) .S X=$G(^RCY(344.4,RCIEN,0)) Q:X="" ; top level entry not found "RTN","RCDPEARL",200,0) .S RSLT="^sub-file 344.41 no entries" "RTN","RCDPEARL",201,0) .; take first entry that gives result from file #430.2 "RTN","RCDPEARL",202,0) .N J,C S (J,C)=0 F S J=$O(^RCY(344.4,RCIEN,1,J)) Q:'J!RSLT S X=$G(^(J,0)) D "RTN","RCDPEARL",203,0) ..S PF=361.1,RSLT="^no pointer to "_PF "RTN","RCDPEARL",204,0) ..S Y=+$P(X,U,2) Q:'(Y>0) S C=C+1 "RTN","RCDPEARL",205,0) ..S RSLT="^sub-file 344.41 total checked "_C,F=$$PTR4302(PF_";"_Y) S:F RSLT=F "RTN","RCDPEARL",206,0) ; "RTN","RCDPEARL",207,0) ; AR BATCH PAYMENT file #344, (#.18) ERA REFERENCE [18P:344.4] "RTN","RCDPEARL",208,0) I RCFLNUM=344 D Q RSLT "RTN","RCDPEARL",209,0) .S X=$G(^RCY(344,RCIEN,0)) Q:X="" "RTN","RCDPEARL",210,0) .S PF=344.4,Y=+$P(X,U,18),RSLT="^no pointer to "_PF Q:'(Y>0) "RTN","RCDPEARL",211,0) .S RSLT=$$PTR4302(PF_";"_Y) "RTN","RCDPEARL",212,0) ; "RTN","RCDPEARL",213,0) ; finished all checks, valid file number not found "RTN","RCDPEARL",214,0) S RSLT=U_"invalid file #"_RCFLNUM "RTN","RCDPEARL",215,0) ; "RTN","RCDPEARL",216,0) Q RSLT "RTN","RCDPEARL",217,0) ; "RTN","RCDPEARL",218,0) SL(T,RCLNCNT,RC2GLBL) ; Set text into global or write line "RTN","RCDPEARL",219,0) ; T = text to output "RTN","RCDPEARL",220,0) ; RCLNCNT = line counter, passed by ref. (optional) "RTN","RCDPEARL",221,0) ; RC2GLBL = if non-null indicates output to global, no writes "RTN","RCDPEARL",222,0) I $G(RC2GLBL)="" W !,T Q "RTN","RCDPEARL",223,0) S RCLNCNT=RCLNCNT+1,^TMP($J,RC2GLBL,RCLNCNT)=T "RTN","RCDPEARL",224,0) Q "RTN","RCDPEARL",225,0) ; "RTN","RCDPEARL",226,0) UP(A) ; Returns UPPERCASE "RTN","RCDPEARL",227,0) Q $$UP^XLFSTR(A) "RTN","RCDPEE") 0^19^B114741630 "RTN","RCDPEE",1,0) RCDPEE ;AITC/FA -Select Partially Matched EFTs ; 29-MAY-2018 "RTN","RCDPEE",2,0) ;;4.5;Accounts Receivable;**332**;Mar 20, 1995;Build 40 "RTN","RCDPEE",3,0) ;Per VA Directive 6402, this routine should not be modified. "RTN","RCDPEE",4,0) Q "RTN","RCDPEE",5,0) ; "RTN","RCDPEE",6,0) EN(ERAIEN) ;EP from Manual Match, MATCH1^RCDPEM2 "RTN","RCDPEE",7,0) ; Input: ERAIEN - IEN of the ERA to show partial matches for "RTN","RCDPEE",8,0) ; Returns: IEN of the selected EFT or "" if none selected "RTN","RCDPEE",9,0) N RCQUIT,XX "RTN","RCDPEE",10,0) S RCQUIT=0 "RTN","RCDPEE",11,0) K ^TMP("RCPM_PARAMS",$J),^TMP("RCDPEU1",$J) "RTN","RCDPEE",12,0) S ^TMP("RCPM_PARAMS",$J,"ERAIEN")=ERAIEN "RTN","RCDPEE",13,0) D FULL^VALM1 "RTN","RCDPEE",14,0) S RCQUIT=$$DTR() ; Set date range filter "RTN","RCDPEE",15,0) Q:RCQUIT "RTN","RCDPEE",16,0) S RCQUIT=$$CLAIMTYP() ; Ask Claim Type "RTN","RCDPEE",17,0) Q:RCQUIT "RTN","RCDPEE",18,0) S RCQUIT=$$PAYR() ; Ask for selected payers "RTN","RCDPEE",19,0) Q:RCQUIT "RTN","RCDPEE",20,0) D EN^VALM("RCDPE EFT PARTIAL MATCH") "RTN","RCDPEE",21,0) Q "RTN","RCDPEE",22,0) ; "RTN","RCDPEE",23,0) DTR() ;EP from RCDPEPMR "RTN","RCDPEE",24,0) ; Date Range Selection "RTN","RCDPEE",25,0) ; Input: ^TMP("RCPM_PARAMS",$J,"RCDT") - Current selected Date Range (if any) "RTN","RCDPEE",26,0) ; Output: ^TMP("RCPM_PARAMS",$J,"RCDT") - Updated Selected Date Range "RTN","RCDPEE",27,0) ; Returns: 1 if user quit or timed out, 0 otherwise "RTN","RCDPEE",28,0) N DIR,DIRUT,DTOUT,DTQUIT,DUOUT,FROM,RCDTRNG,TO,Y "RTN","RCDPEE",29,0) S ^TMP("RCPM_PARAMS",$J,"RCDT")="0^"_DT "RTN","RCDPEE",30,0) S DTQUIT=0 "RTN","RCDPEE",31,0) S FROM=$P($G(^TMP("RCPM_PARAMS",$J,"RCDT")),"^",1) "RTN","RCDPEE",32,0) S TO=$P($G(^TMP("RCPM_PARAMS",$J,"RCDT")),"^",2) "RTN","RCDPEE",33,0) S RCDTRNG=$$DTRANGE(FROM,TO) "RTN","RCDPEE",34,0) Q:RCDTRNG="^" 1 "RTN","RCDPEE",35,0) S ^TMP("RCPM_PARAMS",$J,"RCDT")=RCDTRNG "RTN","RCDPEE",36,0) Q 0 "RTN","RCDPEE",37,0) ; "RTN","RCDPEE",38,0) DTRANGE(DEFFROM,DEFTO) ; Asks for and returns a Date Range "RTN","RCDPEE",39,0) ; Input: DEFFROM - Default FROM date "RTN","RCDPEE",40,0) ; DEFTO - Default TO date "RTN","RCDPEE",41,0) ; Output: From_Date^To_Date (YYYMMDD^YYYDDMM) or "^" (timeout or ^ entered) "RTN","RCDPEE",42,0) N DIR,Y,DTOUT,DUOUT,RCDFR,START "RTN","RCDPEE",43,0) S RCQUIT=0 "RTN","RCDPEE",44,0) S DIR(0)="DAE^:"_DT_":E" "RTN","RCDPEE",45,0) S DIR("A")="Earliest date: " "RTN","RCDPEE",46,0) S DIR("?")="Enter the start of the date range." "RTN","RCDPEE",47,0) S:($G(DEFFROM)) DIR("B")=$$FMTE^XLFDT(DEFFROM,2) "RTN","RCDPEE",48,0) D ^DIR "RTN","RCDPEE",49,0) I $D(DTOUT)!$D(DUOUT) Q "^" "RTN","RCDPEE",50,0) S RCDFR=Y,START=$$FMTE^XLFDT(RCDFR,"2DZ") "RTN","RCDPEE",51,0) K DIR "RTN","RCDPEE",52,0) S DIR(0)="DAE^"_RCDFR_":"_DT_":E" "RTN","RCDPEE",53,0) S DIR("A")="Latest date: " "RTN","RCDPEE",54,0) S DIR("?",1)="Enter the end of the date range. The ending date must be greater than " "RTN","RCDPEE",55,0) S DIR("?")="or equal to "_START_"." "RTN","RCDPEE",56,0) S:($G(DEFTO)) DIR("B")=$$FMTE^XLFDT(DEFTO,2) "RTN","RCDPEE",57,0) D ^DIR "RTN","RCDPEE",58,0) I $D(DTOUT)!$D(DUOUT) Q "^" "RTN","RCDPEE",59,0) Q (RCDFR_"^"_Y) "RTN","RCDPEE",60,0) ; "RTN","RCDPEE",61,0) CLAIMTYP() ;EP from RCDPEPMR "RTN","RCDPEE",62,0) ; Claim Type (Medical/Pharmacy/Both) Selection "RTN","RCDPEE",63,0) ; Input: ^TMP("RCPM_PARAMS") - Global array of preferred values (if any) "RTN","RCDPEE",64,0) ; Output: ^TMP("RCPM_PARAMS",$J,"RCTYPE") - EFT Claim Type filter "RTN","RCDPEE",65,0) ; Returns: 1 if user quit or timed out, 0 otherwise "RTN","RCDPEE",66,0) N RCTYPE "RTN","RCDPEE",67,0) S RCTYPE=$$RTYPE^RCDPEU1("ALL") "RTN","RCDPEE",68,0) I RCTYPE<0 Q 1 "RTN","RCDPEE",69,0) S ^TMP("RCPM_PARAMS",$J,"RCTYPE")=RCTYPE "RTN","RCDPEE",70,0) Q 0 "RTN","RCDPEE",71,0) ; "RTN","RCDPEE",72,0) PAYR() ;EP from RCDPEPMR "RTN","RCDPEE",73,0) ; Payer Selection "RTN","RCDPEE",74,0) ; Input: ^TMP("RCPM_PARAMS",$J,"RCTYPE") - M/P/T filter selection "RTN","RCDPEE",75,0) ; Output: ^TMP("RCPM_PARAMS",$J,"RCPAYR") - Payer filter selection "RTN","RCDPEE",76,0) ; ^TMP("RCDPEU1",$J) - If specific payers were selected "RTN","RCDPEE",77,0) ; Returns: 1 if user quit or timed out, 0 otherwise "RTN","RCDPEE",78,0) N RCPAR,RCPAY,RCTYPE,XX "RTN","RCDPEE",79,0) K ^TMP("RCPDEU1",$J) "RTN","RCDPEE",80,0) S RCTYPE=$G(^TMP("RCPM_PARAMS",$J,"RCTYPE")) "RTN","RCDPEE",81,0) S RCPAY=$$PAYRNG^RCDPEU1(0,0,0,"SELECT") ; Selected or Range of Payers "RTN","RCDPEE",82,0) Q:RCPAY=-1 1 "RTN","RCDPEE",83,0) ; "RTN","RCDPEE",84,0) I RCPAY'="A" D Q:XX=-1 1 ; Since we don't want all payers "RTN","RCDPEE",85,0) . S RCPAR("SELC")=RCPAY ; prompt for payers we do want "RTN","RCDPEE",86,0) . S RCPAR("TYPE")=RCTYPE "RTN","RCDPEE",87,0) . S RCPAR("FILE")=344.31 "RTN","RCDPEE",88,0) . S RCPAR("DICA")="Select Insurance Company NAME: " "RTN","RCDPEE",89,0) . S XX=$$SELPAY^RCDPEU1(.RCPAR) "RTN","RCDPEE",90,0) S ^TMP("RCPM_PARAMS",$J,"RCPAYR")=RCPAY "RTN","RCDPEE",91,0) Q 0 "RTN","RCDPEE",92,0) ; "RTN","RCDPEE",93,0) HDR ;EP from listman template RCDPE EFT PARTIAL MATCH "RTN","RCDPEE",94,0) ; Display listman header "RTN","RCDPEE",95,0) ; Input: ^TMP("RCPM_PARAMS",$J) "RTN","RCDPEE",96,0) ; Output: VALMHDR "RTN","RCDPEE",97,0) N ERAIEN,X,XX,XX2,YY "RTN","RCDPEE",98,0) S X=$G(^TMP("RCPM_PARAMS",$J,"RCDT")) "RTN","RCDPEE",99,0) S XX="DATE RANGE: " "RTN","RCDPEE",100,0) S XX=XX_$$FMTE^XLFDT($P(X,"^",1),"2ZD") "RTN","RCDPEE",101,0) I $P(X,"^",2) S XX=XX_"-"_$$FMTE^XLFDT($P(X,"^",2),"2ZD") "RTN","RCDPEE",102,0) S X=$G(^TMP("RCPM_PARAMS",$J,"RCTYPE")) "RTN","RCDPEE",103,0) S XX2="M/P/T: " "RTN","RCDPEE",104,0) S XX2=XX2_$S(X="M":"MEDICAL ONLY",X="P":"PHARMACY ONLY",X="T":"TRICARE ONLY",1:"ALL") "RTN","RCDPEE",105,0) S XX=$$SETSTR^VALM1(XX2,XX,35,21) "RTN","RCDPEE",106,0) ; "RTN","RCDPEE",107,0) S X=$G(^TMP("RCPM_PARAMS",$J,"RCPAYR")) "RTN","RCDPEE",108,0) I $P(X,"^",1)="A"!(X="") D "RTN","RCDPEE",109,0) . S XX2="ALL PAYERS" "RTN","RCDPEE",110,0) E S XX2="SELECTED" "RTN","RCDPEE",111,0) S XX2="PAYERS: "_XX2 "RTN","RCDPEE",112,0) S XX=$$SETSTR^VALM1(XX2,XX,62,18) "RTN","RCDPEE",113,0) S VALMHDR(1)=XX "RTN","RCDPEE",114,0) ; "RTN","RCDPEE",115,0) ; Build 2nd Header Line "RTN","RCDPEE",116,0) S ERAIEN=$G(^TMP("RCPM_PARAMS",$J,"ERAIEN")) "RTN","RCDPEE",117,0) S XX="ERA #: "_ERAIEN "RTN","RCDPEE",118,0) S XX2=$$GET1^DIQ(344.4,ERAIEN_",",.02,"I") ; ERA Trace # "RTN","RCDPEE",119,0) S XX2="Trace #: "_XX2 "RTN","RCDPEE",120,0) S XX=$$SETSTR^VALM1(XX2,XX,20,60) "RTN","RCDPEE",121,0) S VALMHDR(2)=XX "RTN","RCDPEE",122,0) ; "RTN","RCDPEE",123,0) ; Build 3rd Header Line "RTN","RCDPEE",124,0) S YY=$$GET1^DIQ(344.4,ERAIEN_",",.03,"I") ; ERA Payer TIN "RTN","RCDPEE",125,0) S XX=$$GET1^DIQ(344.4,ERAIEN_",",.06,"I") ; ERA Payer Name "RTN","RCDPEE",126,0) S XX2=XX_"/"_YY "RTN","RCDPEE",127,0) S:$L(XX2)>63 XX2=$E(XX,1,79-$L(YY))_"/"_YY "RTN","RCDPEE",128,0) S VALMHDR(3)="Payer Name/TIN: "_XX2 "RTN","RCDPEE",129,0) ; "RTN","RCDPEE",130,0) ; Build 4TH Header Line "RTN","RCDPEE",131,0) S YY=$$GET1^DIQ(344.4,ERAIEN_",",.05,"I") ; ERA Total Amount Paid "RTN","RCDPEE",132,0) S XX=" Total Amt Pd: "_$J(YY,12,2) "RTN","RCDPEE",133,0) S VALMHDR(4)=XX "RTN","RCDPEE",134,0) ; "RTN","RCDPEE",135,0) S VALMHDR(5)="" "RTN","RCDPEE",136,0) S VALMHDR(6)=" # EFT # Trace Number Total Amt Pd" "RTN","RCDPEE",137,0) Q "RTN","RCDPEE",138,0) ; "RTN","RCDPEE",139,0) INIT ;EP from listman template RCDPE EFT PARTIAL MATCH "RTN","RCDPEE",140,0) ; Display listman body "RTN","RCDPEE",141,0) ; Build the display of EFTs that are partially matched "RTN","RCDPEE",142,0) ; Input: ^TMP("RCPM_PARAMS",#J) - Selected Parameters "RTN","RCDPEE",143,0) N EFTAMT,EFTDR,EFTREM,EFTTIN,EFTTR,ERAIEN,ERATIN,ERATOT,ERATR,RCDTFR,RCDTTO,XX "RTN","RCDPEE",144,0) D CLEAN^VALM10 "RTN","RCDPEE",145,0) K ^TMP("RCPM-WL",$J),^TMP("RCPM-WL_WLDX",$J),^TMP($J,"RCPM_LIST") "RTN","RCDPEE",146,0) S ERAIEN=$G(^TMP("RCPM_PARAMS",$J,"ERAIEN")) "RTN","RCDPEE",147,0) S XX=$G(^TMP("RCPM_PARAMS",$J,"RCDT")) "RTN","RCDPEE",148,0) S RCDTFR=+$P(XX,"^",1) "RTN","RCDPEE",149,0) S RCDTTO=$S($P(XX,"^",2):$P(XX,"^",2),1:DT) "RTN","RCDPEE",150,0) S ERATIN=$$GET1^DIQ(344.4,ERAIEN_",",.03,"I") ; ERA Payer TIN "RTN","RCDPEE",151,0) S ERATIN=$$UP^XLFSTR(ERATIN) "RTN","RCDPEE",152,0) S ERATR=$$GET1^DIQ(344.4,ERAIEN_",",.02,"I") ; ERA Trace # "RTN","RCDPEE",153,0) S ERATR=$$UP^XLFSTR(ERATR) "RTN","RCDPEE",154,0) S ERATOT=$$GET1^DIQ(344.4,ERAIEN_",",.05,"I") ; ERA Total Amount Paid "RTN","RCDPEE",155,0) S EFTIEN=0 "RTN","RCDPEE",156,0) ; "RTN","RCDPEE",157,0) ; Search for all unmatched, not removed EFTs that are partially matched for "RTN","RCDPEE",158,0) ; the specified date range "RTN","RCDPEE",159,0) F D Q:'EFTIEN "RTN","RCDPEE",160,0) . S EFTIEN=$O(^RCY(344.31,"AMATCH",0,EFTIEN)) "RTN","RCDPEE",161,0) . Q:'EFTIEN "RTN","RCDPEE",162,0) . S EFTREM=$$GET1^DIQ(344.31,EFTIEN_",",.17,"I") ; User who removed EFT "RTN","RCDPEE",163,0) . Q:EFTREM'="" ; Skip removed EFTs "RTN","RCDPEE",164,0) . S EFTAMT=$$GET1^DIQ(344.31,EFTIEN_",",.07,"I") ; Amount of Payment "RTN","RCDPEE",165,0) . Q:'EFTAMT ; Skip EFTs with no Payment Amount "RTN","RCDPEE",166,0) . S EFTDR=$$GET1^DIQ(344.31,EFTIEN_",",.13,"I") ; Date Received "RTN","RCDPEE",167,0) . Q:$$FMDIFF^XLFDT(RCDTFR,EFTDR,1)>0 ; Date Received before start of range "RTN","RCDPEE",168,0) . Q:$$FMDIFF^XLFDT(EFTDR,RCDTTO,1)>0 ; Date Received after end of range "RTN","RCDPEE",169,0) . Q:'$$FILTEFT(EFTIEN) ; Didn't pass selected filters "RTN","RCDPEE",170,0) . D EFTCHK(EFTIEN,ERATIN,ERATOT,ERATR) ; Check for partial matched EFTs "RTN","RCDPEE",171,0) ; "RTN","RCDPEE",172,0) I $D(^TMP($J,"RCPM_LIST")) D BLD Q ; Build the list main display "RTN","RCDPEE",173,0) ; "RTN","RCDPEE",174,0) ; No EFTs found, display the message below in the list area "RTN","RCDPEE",175,0) S ^TMP("RCPM-WL",$J,1,0)="THERE ARE NO EFTs MATCHING YOUR SELECTION CRITERIA" "RTN","RCDPEE",176,0) S VALMCNT=0 "RTN","RCDPEE",177,0) Q "RTN","RCDPEE",178,0) ; "RTN","RCDPEE",179,0) EFTCHK(EFTIEN,ERATIN,ERATOT,ERATR) ; Check for partially matched EFTs "RTN","RCDPEE",180,0) ; Input: EFTIEN - IEN of the EFT being checked (#344.31) "RTN","RCDPEE",181,0) ; ERATIN - Payer TIN on the ERA record "RTN","RCDPEE",182,0) ; ERATOT - ERA Total Amount Paid "RTN","RCDPEE",183,0) ; ERATR - ERA Trace # "RTN","RCDPEE",184,0) ; Output: ^TMP($J,"RCPM_LIST,MATCHW,EFTSEQ)=A1^...^A11 Where "RTN","RCDPEE",185,0) ; MATCHW - Weighted number derived from partial matches "RTN","RCDPEE",186,0) ; EFTSEQ - Unique EFT Sequence # "RTN","RCDPEE",187,0) ; A1 - Number of matches between the ERA and the EFT "RTN","RCDPEE",188,0) ; A2 - Payer TIN # if matched, else "" "RTN","RCDPEE",189,0) ; A3 - Payer Trace # if matched, else "" "RTN","RCDPEE",190,0) ; A4 - Total Amount paid if matched else "" "RTN","RCDPEE",191,0) ; A5 - Matched weighted value "RTN","RCDPEE",192,0) ; 10 points for a match on Trace Number "RTN","RCDPEE",193,0) ; 5 points for a match on Total Amount "RTN","RCDPEE",194,0) ; 1 point for a match on TIN "RTN","RCDPEE",195,0) ; Only matches with a weigted value of 5 or more are displayed "RTN","RCDPEE",196,0) ; A6 - EFT IEN "RTN","RCDPEE",197,0) ; A7 - Deposit # "RTN","RCDPEE",198,0) ; A8 - Internal Deposit Date "RTN","RCDPEE",199,0) ; A9 - Payer Name/TIN (max 58 characters) "RTN","RCDPEE",200,0) ; A10- EFT Trace # "RTN","RCDPEE",201,0) ; A11- EFT Total Amount Paid "RTN","RCDPEE",202,0) N DEPDT,DEPNUM,EFTSEQ,EFTTOT,EFTTIN,EFTTR,MATCH,MATCHW,PAYNM,XX,YY "RTN","RCDPEE",203,0) ; "RTN","RCDPEE",204,0) S (EFTSEQ,XX)=$$GET1^DIQ(344.31,EFTIEN_",",.01,"I") ; IEN for 344.3 "RTN","RCDPEE",205,0) S DEPNUM=$$GET1^DIQ(344.3,XX_",",.06,"I") ; Deposit # "RTN","RCDPEE",206,0) S DEPDT=$$GET1^DIQ(344.3,XX_",",.07,"I") ; Deposit Date "RTN","RCDPEE",207,0) Q:$E(DEPNUM,1,3)="HAC" "RTN","RCDPEE",208,0) S MATCHW=0,MATCH="" "RTN","RCDPEE",209,0) S XX=$$GET1^DIQ(344.31,EFTIEN_",",.14,"I") ; EFT Transaction # "RTN","RCDPEE",210,0) S:XX'="" EFTSEQ=EFTSEQ_"."_XX ; EFT Sequence number "RTN","RCDPEE",211,0) S EFTTOT=$$GET1^DIQ(344.31,EFTIEN_",",.07,"I") ; EFT Total Amount Paid "RTN","RCDPEE",212,0) S EFTTIN=$$GET1^DIQ(344.31,EFTIEN_",",.03,"I") ; EFT TIN "RTN","RCDPEE",213,0) S EFTTIN=$$UP^XLFSTR(EFTTIN) "RTN","RCDPEE",214,0) S EFTTR=$$GET1^DIQ(344.31,EFTIEN_",",.04,"I") ; EFT Trace # "RTN","RCDPEE",215,0) S EFTTR=$$UP^XLFSTR(EFTTR) "RTN","RCDPEE",216,0) I EFTTIN=ERATIN D ; Payer TIN match "RTN","RCDPEE",217,0) . S MATCH=1,MATCHW=MATCHW+1 "RTN","RCDPEE",218,0) . S $P(MATCH,"^",2)=EFTTIN "RTN","RCDPEE",219,0) I EFTTR=ERATR D ; Trace # number match "RTN","RCDPEE",220,0) . S XX=$P(MATCH,"^",1),MATCHW=MATCHW+10 "RTN","RCDPEE",221,0) . S $P(MATCH,"^",1)=XX+1 "RTN","RCDPEE",222,0) . S $P(MATCH,"^",3)=EFTTR "RTN","RCDPEE",223,0) I EFTTOT=ERATOT D ; Total Amount Paid match "RTN","RCDPEE",224,0) . S XX=$P(MATCH,"^",1),MATCHW=MATCHW+5 "RTN","RCDPEE",225,0) . S $P(MATCH,"^",1)=XX+1 "RTN","RCDPEE",226,0) . S $P(MATCH,"^",4)=EFTTOT "RTN","RCDPEE",227,0) Q:MATCHW<5 ; Only TIN match, skip "RTN","RCDPEE",228,0) S $P(MATCH,"^",6)=EFTIEN ; EFT IEN "RTN","RCDPEE",229,0) S $P(MATCH,"^",7)=DEPNUM ; Deposit # "RTN","RCDPEE",230,0) S $P(MATCH,"^",8)=DEPDT ; Deposit Date (internal) "RTN","RCDPEE",231,0) S PAYNM=$$GET1^DIQ(344.31,EFTIEN_",",.02,"I") ; EFT Payer Name "RTN","RCDPEE",232,0) S XX=PAYNM_"/"_EFTTIN "RTN","RCDPEE",233,0) S:$L(XX)>73 XX=$E(PAYNM,1,79-$L(EFTTIN))_"/"_EFTTIN "RTN","RCDPEE",234,0) S $P(MATCH,"^",9)=XX "RTN","RCDPEE",235,0) S $P(MATCH,"^",10)=EFTTR "RTN","RCDPEE",236,0) S $P(MATCH,"^",11)=EFTTOT "RTN","RCDPEE",237,0) S ^TMP($J,"RCPM_LIST",MATCHW,EFTSEQ)=MATCH "RTN","RCDPEE",238,0) Q "RTN","RCDPEE",239,0) ; "RTN","RCDPEE",240,0) FILTEFT(EFTIEN) ; Check to see if the EFT passes filter checks "RTN","RCDPEE",241,0) ; Input: EFTIEN - IEN for the EFT (#344.31) "RTN","RCDPEE",242,0) ; ^TMP("RCPM_PARAMS",$J,"RCPAYR") - Payer Selection - 'A','S' or 'R' "RTN","RCDPEE",243,0) ; ^TMP("RCPM_PARAMS",$J,"RCTYPE") - M/P/T Selection - 'A','M', 'P' or 'T' "RTN","RCDPEE",244,0) ; ^TMP("RCDPEU1",$J) - Selected payers if ALL not selected "RTN","RCDPEE",245,0) ; Returns: 1 if EFT passes filter checks, 0 otherwise "RTN","RCDPEE",246,0) N RCFLAG,RCPAY,RCTYPE,XX "RTN","RCDPEE",247,0) S XX=$G(^TMP("RCPM_PARAMS",$J,"RCPAYR")) "RTN","RCDPEE",248,0) S RCPAY=$P(XX,"^",1) "RTN","RCDPEE",249,0) S RCTYPE=$G(^TMP("RCPM_PARAMS",$J,"RCTYPE")) "RTN","RCDPEE",250,0) ; "RTN","RCDPEE",251,0) ; Payer filter check "RTN","RCDPEE",252,0) I RCPAY'="A" D Q:'XX 0 "RTN","RCDPEE",253,0) . S XX=$$ISSEL^RCDPEU1(344.31,EFTIEN) "RTN","RCDPEE",254,0) ; "RTN","RCDPEE",255,0) ; M/P/T filter check "RTN","RCDPEE",256,0) I RCTYPE'="A" D Q:'XX 0 "RTN","RCDPEE",257,0) . S XX=$$ISTYPE^RCDPEU1(344.31,EFTIEN,RCTYPE) "RTN","RCDPEE",258,0) Q 1 "RTN","RCDPEE",259,0) ; "RTN","RCDPEE",260,0) BLD ; Build listman dislay "RTN","RCDPEE",261,0) ; Input: ^TMP($J,"RCPM_LIST,MATCHW,EFTSEQ)=A1^...^A11 Where: "RTN","RCDPEE",262,0) ; MATCHW - Weighted number derived from partial matches "RTN","RCDPEE",263,0) ; EFTSEQ - Unique EFT Sequence # "RTN","RCDPEE",264,0) ; A1 - Number of matches between the ERA and the EFT "RTN","RCDPEE",265,0) ; A2 - Payer TIN # if matched, else "" "RTN","RCDPEE",266,0) ; A3 - Payer Trace # if matched, else "" "RTN","RCDPEE",267,0) ; A4 - Total Amount paid if matched else "" "RTN","RCDPEE",268,0) ; A5 - Matched weighted value "RTN","RCDPEE",269,0) ; 10 points for a match on Trace Number "RTN","RCDPEE",270,0) ; 5 points for a match on Total Amount "RTN","RCDPEE",271,0) ; 1 point for a match on TIN "RTN","RCDPEE",272,0) ; Only matches with a weigted value of 5 or more are displayed "RTN","RCDPEE",273,0) ; A6 - EFT IEN "RTN","RCDPEE",274,0) ; A7 - Deposit # "RTN","RCDPEE",275,0) ; A8 - Internal Deposit Date "RTN","RCDPEE",276,0) ; A9 - Payer Name/TIN (max 58 characters) "RTN","RCDPEE",277,0) ; A10- EFT Trace # "RTN","RCDPEE",278,0) ; A11- EFT Total Amount Paid "RTN","RCDPEE",279,0) N CTR,EFTSEQ,MATCH,MATCHW "RTN","RCDPEE",280,0) S CTR=1 "RTN","RCDPEE",281,0) S VALMCNT=0 "RTN","RCDPEE",282,0) S MATCHW="" "RTN","RCDPEE",283,0) F D Q:MATCHW="" "RTN","RCDPEE",284,0) . S MATCHW=$O(^TMP($J,"RCPM_LIST",MATCHW),-1) "RTN","RCDPEE",285,0) . Q:MATCHW="" "RTN","RCDPEE",286,0) . S EFTSEQ="" "RTN","RCDPEE",287,0) . F D Q:EFTSEQ="" "RTN","RCDPEE",288,0) . . S EFTSEQ=$O(^TMP($J,"RCPM_LIST",MATCHW,EFTSEQ)) "RTN","RCDPEE",289,0) . . Q:EFTSEQ="" "RTN","RCDPEE",290,0) . . S MATCH=^TMP($J,"RCPM_LIST",MATCHW,EFTSEQ) "RTN","RCDPEE",291,0) . . D DISPEFT(MATCH,EFTSEQ,.CTR,.VALMCNT) "RTN","RCDPEE",292,0) ; "RTN","RCDPEE",293,0) K ^TMP($J,"RCPM_LIST") "RTN","RCDPEE",294,0) S VALMSG="Enter ?? for more actions and help" "RTN","RCDPEE",295,0) Q "RTN","RCDPEE",296,0) ; "RTN","RCDPEE",297,0) DISPEFT(MATCH,EFTSEQ,CTR,VALMCNT) ; Build the display for one EFT "RTN","RCDPEE",298,0) ; Input: MATCH - A1^...^A11 Where: "RTN","RCDPEE",299,0) ; A1 - Number of matches between the ERA and the EFT "RTN","RCDPEE",300,0) ; A2 - Payer TIN # if matched, else "" "RTN","RCDPEE",301,0) ; A3 - Payer Trace # if matched, else "" "RTN","RCDPEE",302,0) ; A4 - Total Amount paid if matched else "" "RTN","RCDPEE",303,0) ; A5 - Matched weighted value "RTN","RCDPEE",304,0) ; 10 points for a match on Trace Number "RTN","RCDPEE",305,0) ; 5 points for a match on Total Amount "RTN","RCDPEE",306,0) ; 1 point for a match on TIN "RTN","RCDPEE",307,0) ; Only matches with a weigted value of 5 or more are displayed "RTN","RCDPEE",308,0) ; A6 - EFT IEN "RTN","RCDPEE",309,0) ; A7 - Deposit # "RTN","RCDPEE",310,0) ; A8 - Internal Deposit Date "RTN","RCDPEE",311,0) ; A9 - Payer Name/TIN (max 58 characters) "RTN","RCDPEE",312,0) ; A10- EFT Trace # "RTN","RCDPEE",313,0) ; A11- EFT Total Amount Paid "RTN","RCDPEE",314,0) ; EFTSEQ - Unique EFT sequence # "RTN","RCDPEE",315,0) ; CTR - Current EFT counter "RTN","RCDPEE",316,0) ; VALMCNT - Current Listman body line counter "RTN","RCDPEE",317,0) ; Output: CTR - Updated EFT counter "RTN","RCDPEE",318,0) ; VALMCNT - Updated Listman body line counter "RTN","RCDPEE",319,0) N EFTIEN,X,XX,TT "RTN","RCDPEE",320,0) S EFTIEN=$P(MATCH,"^",6) ; EFT IEN "RTN","RCDPEE",321,0) ; "RTN","RCDPEE",322,0) ; Build first display line of the EFT "RTN","RCDPEE",323,0) S YY=$P(MATCH,"^",10) ; Trace Number "RTN","RCDPEE",324,0) S X=$E(CTR_$J("",4),1,4)_" "_$E(EFTSEQ_$J("",10),1,10)_" "_$E(YY_$J("",50),1,50) "RTN","RCDPEE",325,0) S X=X_" "_$J($P(MATCH,"^",11),12,2) ; Total Amount Paid "RTN","RCDPEE",326,0) D SET(X,CTR,EFTIEN,.VALMCNT) "RTN","RCDPEE",327,0) ; "RTN","RCDPEE",328,0) ; Build second display line of the EFT "RTN","RCDPEE",329,0) S XX=$P(MATCH,"^",9) "RTN","RCDPEE",330,0) S X=" "_$E(XX_$J("",73),1,73) ; Payer Name/TIN "RTN","RCDPEE",331,0) D SET(X,CTR,EFTIEN,.VALMCNT) "RTN","RCDPEE",332,0) D SET(" ",CTR,"",.VALMCNT) ; Display blank line "RTN","RCDPEE",333,0) S CTR=CTR+1 "RTN","RCDPEE",334,0) S VALMSG="Enter ?? for more actions and help" "RTN","RCDPEE",335,0) Q "RTN","RCDPEE",336,0) ; "RTN","RCDPEE",337,0) SET(X,RCSEQ,EFTIEN,VALMCNT) ; Set listman body and selection arrays "RTN","RCDPEE",338,0) ; Input: X - Data to set into the display line "RTN","RCDPEE",339,0) ; RCSEQ - Selectable line # "RTN","RCDPEE",340,0) ; EFTIEN - IEN of the EFT record (#344.31) "RTN","RCDPEE",341,0) ; VALMCNT - Current Display line counter "RTN","RCDPEE",342,0) ; ^TMP("RCPM-WL",$J) - Current global array of body display lines "RTN","RCDPEE",343,0) ; ^TMP("RCPM-WL_WLDX",$J,RCSEQ) -VALMCNT_"^"_EFTIEN "RTN","RCDPEE",344,0) ; Output: VALMCNT - Updated Display line counter "RTN","RCDPEE",345,0) ; ^TMP("RCPM--WL",$J,VALMCNT,0) - Updated display lines with new line "RTN","RCDPEE",346,0) ; ^TMP("RCPM-WL_WLDX",$J,RCSEQ) -VALMCNT_"^"_ERAIEN "RTN","RCDPEE",347,0) S VALMCNT=VALMCNT+1,^TMP("RCPM-WL",$J,VALMCNT,0)=X "RTN","RCDPEE",348,0) S:$G(RCSEQ) ^TMP("RCPM-WL",$J,"IDX",VALMCNT,RCSEQ)=$G(EFTIEN) "RTN","RCDPEE",349,0) S:$G(EFTIEN) ^TMP("RCPM-WL_WLDX",$J,RCSEQ)=VALMCNT_"^"_EFTIEN "RTN","RCDPEE",350,0) Q "RTN","RCDPEE",351,0) ; "RTN","RCDPEE",352,0) HELP ;EP from listman template RCDPE EFT PARTIAL MATCH "RTN","RCDPEE",353,0) ; help code "RTN","RCDPEE",354,0) S X="?" D DISP^XQORM1 W !! "RTN","RCDPEE",355,0) Q "RTN","RCDPEE",356,0) ; "RTN","RCDPEE",357,0) EXIT ;EP from listman template RCDPE EFT PARTIAL MATCH "RTN","RCDPEE",358,0) ; Exit code "RTN","RCDPEE",359,0) K ^TMP("RCPM_PARAMS",$J),^TMP("RCDPEU1",$J) "RTN","RCDPEE",360,0) K ^TMP("RCPM-WL",$J),^TMP("RCPM-WL_WLDX",$J),^TMP($J,"RCPM_LIST") "RTN","RCDPEE",361,0) Q "RTN","RCDPEE",362,0) ; "RTN","RCDPEE",363,0) SELEFT ;EP from RCDPE EFT PARTIAL MATCH SELECT "RTN","RCDPEE",364,0) ; Input: None "RTN","RCDPEE",365,0) ; Output: ^TMP($J,"SELEFT")-EFTIEN if an EFT was selected "RTN","RCDPEE",366,0) N PCNT,PROMPT,RCEFT,SEL "RTN","RCDPEE",367,0) D FULL^VALM1 "RTN","RCDPEE",368,0) S VALM("ENTITY")="#" "RTN","RCDPEE",369,0) D EN^VALM2($G(XQORNOD(0)),"S") "RTN","RCDPEE",370,0) S PCNT=$O(VALMY(0)) "RTN","RCDPEE",371,0) Q:'PCNT "RTN","RCDPEE",372,0) S RCEFT=$P(^TMP("RCPM-WL_WLDX",$J,PCNT),"^",2) "RTN","RCDPEE",373,0) Q:RCEFT="" "RTN","RCDPEE",374,0) S VALMBCK="R" "RTN","RCDPEE",375,0) S RCQUIT=$$SHOWM(RCEFT) "RTN","RCDPEE",376,0) I RCQUIT S VALMBCK="Q" "RTN","RCDPEE",377,0) Q "RTN","RCDPEE",378,0) ; "RTN","RCDPEE",379,0) SHOWM(RCEFT) ; Show EFT details and ask user if this is the correct one "RTN","RCDPEE",380,0) ; Input : RCEFT - IEN of EFT from file 344.31 "RTN","RCDPEE",381,0) ; Returns : 1 - If match was made, 0 - to refresh patial match list, -1 to exit "RTN","RCDPEE",382,0) ; "RTN","RCDPEE",383,0) N DEPDT,DEPNUM,RCQUIT "RTN","RCDPEE",384,0) D GETDINFO^RCDPEM2(RCEFT,.DEPNUM,.DEPDT) "RTN","RCDPEE",385,0) W ! "RTN","RCDPEE",386,0) S DIC="^RCY(344.31,",DR="0",DA=RCEFT D EN^DIQ "RTN","RCDPEE",387,0) W " DEPOSIT NUMBER: ",DEPNUM,?40,"DEPOSIT DATE: ",DEPDT "RTN","RCDPEE",388,0) W ! "RTN","RCDPEE",389,0) S DIR("A")="ARE YOU SURE THIS IS THE EFT YOU WANT TO MATCH?: ",DIR(0)="YA",DIR("B")="YES" D ^DIR K DIR "RTN","RCDPEE",390,0) I $D(DUOUT)!$D(DTOUT) S RCQUIT=1 Q -1 "RTN","RCDPEE",391,0) I Y'=1 Q 0 ; G ML1 CJE*4.5*332 "RTN","RCDPEE",392,0) ; Go to the Manual match, we have the ERA and EFT "RTN","RCDPEE",393,0) S RCQUIT=0 "RTN","RCDPEE",394,0) D M12A^RCDPEM2 "RTN","RCDPEE",395,0) I RCQUIT Q -1 "RTN","RCDPEE",396,0) Q 1 "RTN","RCDPEFTL") 0^3^B84961666 "RTN","RCDPEFTL",1,0) RCDPEFTL ;EDE/FA - LIST LOCKED EFT REPORT ;18 July 2018 11:19:25 "RTN","RCDPEFTL",2,0) ;;4.5;Accounts Receivable;**332**;Mar 20, 1995;Build 40 "RTN","RCDPEFTL",3,0) ;Per VA Directive 6402, this routine should not be modified. "RTN","RCDPEFTL",4,0) ; "RTN","RCDPEFTL",5,0) EN ; Entry from RCDPE EFT OVERRIDE REPORT option "RTN","RCDPEFTL",6,0) N RCINPT,RCVAL "RTN","RCDPEFTL",7,0) K ^TMP("RCDPE_EFTL",$J) "RTN","RCDPEFTL",8,0) ; "RTN","RCDPEFTL",9,0) ; Warn if override set today or not "RTN","RCDPEFTL",10,0) S RCVAL("OverRide")=+$$GET1^DIQ(344.61,1,20,"I") ; (#20) MEDICAL EFT OVERRIDE [1D] "RTN","RCDPEFTL",11,0) W !,"Medical Override "_$S($P(RCVAL("OverRide"),".")=DT:"",1:"not ")_"active for today's date" "RTN","RCDPEFTL",12,0) ; "RTN","RCDPEFTL",13,0) S RCVAL("EFTPostLimit")=+$$GET1^DIQ(344.61,1,.06) ; (#.06) MEDICAL EFT POST PREVENT DAYS [6N] "RTN","RCDPEFTL",14,0) S RCVAL("CutoffDate")=$$FMADD^XLFDT(DT,-RCVAL("EFTPostLimit")) ; Today's date less post prevent days "RTN","RCDPEFTL",15,0) W !,"Aged EFT days before Medical posting prevented = "_RCVAL("EFTPostLimit"),! "RTN","RCDPEFTL",16,0) ; "RTN","RCDPEFTL",17,0) ; Check if any medical unposted EFTs exist with aged days greater than site parameter value "RTN","RCDPEFTL",18,0) S RCVAL("1stEFTDate")=$$GETFRST(RCVAL("EFTPostLimit"),RCVAL("CutoffDate")) "RTN","RCDPEFTL",19,0) ; "RTN","RCDPEFTL",20,0) ; If none stop "RTN","RCDPEFTL",21,0) I 'RCVAL("1stEFTDate") D Q "RTN","RCDPEFTL",22,0) . N DIR "RTN","RCDPEFTL",23,0) . S DIR(0)="EA" "RTN","RCDPEFTL",24,0) . S DIR("A",1)="The system does not have any aged, unposted EFTs." "RTN","RCDPEFTL",25,0) . S DIR("A",2)=" " "RTN","RCDPEFTL",26,0) . S DIR("A")="Press ENTER to continue: " "RTN","RCDPEFTL",27,0) . D ^DIR "RTN","RCDPEFTL",28,0) ; "RTN","RCDPEFTL",29,0) ; report parameters "RTN","RCDPEFTL",30,0) S RCINPT("DateRange")=RCVAL("1stEFTDate")_":"_RCVAL("CutoffDate") ; Start Date:End date "RTN","RCDPEFTL",31,0) S RCINPT("2Excel?")=$$ASKXCEL ; Ask to output to Excel "RTN","RCDPEFTL",32,0) Q:RCINPT("2Excel?")=-1 ; '^' or timeout "RTN","RCDPEFTL",33,0) D:RCINPT("2Excel?")=1 INFO^RCDPEM6 ; Display capture information for Excel "RTN","RCDPEFTL",34,0) S RCINPT("DeviceSelected?")=$$DEVICE(RCINPT("2Excel?")) ; Ask output device "RTN","RCDPEFTL",35,0) Q:'RCINPT("DeviceSelected?") ; '^' or timeout (POP from %ZIS call) "RTN","RCDPEFTL",36,0) ; done with user questions "RTN","RCDPEFTL",37,0) S RCINPT("AgedDays")=RCVAL("EFTPostLimit") ; allowed aged days for report "RTN","RCDPEFTL",38,0) S RCINPT("1stEFT")=RCVAL("1stEFTDate") ; first EFT date for report "RTN","RCDPEFTL",39,0) ; Medical EFT Override parameters "RTN","RCDPEFTL",40,0) S RCINPT(344.61,20)=$$GET1^DIQ(344.61,1_",",20,"E") ; (#20) MEDICAL EFT OVERRIDE [1D] "RTN","RCDPEFTL",41,0) S RCINPT(344.61,22)=$$GET1^DIQ(344.61,1_",",22,"E") ; (#22) USER - MEDICAL OVERRIDE [3P:200] "RTN","RCDPEFTL",42,0) S RCINPT(344.61,24)=$$GET1^DIQ(344.61,1_",",24,"E") ; (#24) COMMENT - MEDICAL OVERRIDE [5F] "RTN","RCDPEFTL",43,0) ; Queue output "RTN","RCDPEFTL",44,0) I $D(IO("Q")) D D HOME^%ZIS Q "RTN","RCDPEFTL",45,0) . N ZTDESC,ZTRTN,ZTSAVE,ZTSK "RTN","RCDPEFTL",46,0) . S ZTRTN="REPORT^RCDPEFTL(.RCINPT)",ZTDESC="RCDPE EFT OVERRIDE REPORT" "RTN","RCDPEFTL",47,0) . S ZTSAVE("RC*")="",ZTSAVE("IO*")="" D ^%ZTLOAD "RTN","RCDPEFTL",48,0) . W !!,$S($D(ZTSK):"Task number "_ZTSK_" was queued.",1:"Unable to queue this task.") "RTN","RCDPEFTL",49,0) . K IO("Q") "RTN","RCDPEFTL",50,0) ; "RTN","RCDPEFTL",51,0) D REPORT(.RCINPT) "RTN","RCDPEFTL",52,0) Q "RTN","RCDPEFTL",53,0) ; "RTN","RCDPEFTL",54,0) REPORT(RCINPT) ; entry point from TaskMan and above "RTN","RCDPEFTL",55,0) D RPTCOMP(.RCINPT) ; Compile report "RTN","RCDPEFTL",56,0) D RPTOUT(.RCINPT) ; Output report "RTN","RCDPEFTL",57,0) I '$D(ZTQUEUED) D ^%ZISC ;if not queued Close device "RTN","RCDPEFTL",58,0) I $D(ZTQUEUED) S ZTREQ="@" "RTN","RCDPEFTL",59,0) K ^TMP("RCDPE_EFTL",$J) "RTN","RCDPEFTL",60,0) K ZTQUEUED "RTN","RCDPEFTL",61,0) Q "RTN","RCDPEFTL",62,0) ; "RTN","RCDPEFTL",63,0) RPTCOMP(RCINPT) ; Full EFT scan to compile report "RTN","RCDPEFTL",64,0) ; Input: "RTN","RCDPEFTL",65,0) ; RCINPT("DateRange")= Report start date:Report end date "RTN","RCDPEFTL",66,0) ; Output: "RTN","RCDPEFTL",67,0) ; ^TMP("RCDPE_EFTL",$J) - compilation of report data "RTN","RCDPEFTL",68,0) ; "RTN","RCDPEFTL",69,0) N END,RCEFT,RECVDT "RTN","RCDPEFTL",70,0) ; RCEFT - array for EFT data, counter, IEN "RTN","RCDPEFTL",71,0) ; "RTN","RCDPEFTL",72,0) ; Initialize report "RTN","RCDPEFTL",73,0) K ^TMP("RCDPE_EFTL",$J) "RTN","RCDPEFTL",74,0) S RCEFT("Count")=0,^TMP("RCDPE_EFTL",$J,"EFT count")=0,^TMP("RCDPE_EFTL",$J,"Total Amt")=0 "RTN","RCDPEFTL",75,0) S RECVDT=$P(RCINPT("DateRange"),":")-.1 ; start date minus fraction "RTN","RCDPEFTL",76,0) S END=$P(RCINPT("DateRange"),":",2) ; report ending date range "RTN","RCDPEFTL",77,0) ; File #344.31 Traditional Cross-Reference: "ADR", REGULAR Field: DATE RECEIVED (344.31,.13) "RTN","RCDPEFTL",78,0) ; Scan EFT received date index for days "RTN","RCDPEFTL",79,0) F S RECVDT=$O(^RCY(344.31,"ADR",RECVDT)) Q:'RECVDT Q:RECVDT>END D "RTN","RCDPEFTL",80,0) . S RCEFT("IEN")="" "RTN","RCDPEFTL",81,0) . ; Scan individual EFTs "RTN","RCDPEFTL",82,0) . F S RCEFT("IEN")=$O(^RCY(344.31,"ADR",RECVDT,RCEFT("IEN"))) Q:'RCEFT("IEN") D "RTN","RCDPEFTL",83,0) .. ; Check this is a valid EFT type "RTN","RCDPEFTL",84,0) .. Q:'$$VALID(RCEFT("IEN")) "RTN","RCDPEFTL",85,0) .. ; calculate aged number of days of the EFT "RTN","RCDPEFTL",86,0) .. S RCEFT("DaysAged")=$$FMDIFF^XLFDT(DT,RECVDT) ; get aged number of days of the EFT "RTN","RCDPEFTL",87,0) .. Q:RCEFT("DaysAged")'>RCVAL("EFTPostLimit") ; Ignore Unposted EFT younger than aged days maximum "RTN","RCDPEFTL",88,0) .. S RCEFT("Trace#")=$$GET1^DIQ(344.31,RCEFT("IEN"),.04) ;(#.04) TRACE # [4F] "RTN","RCDPEFTL",89,0) .. S RCEFT("MatchStatus")=$$GET1^DIQ(344.31,RCEFT("IEN"),.08,"E") ;(#.08) MATCH STATUS [8S] "RTN","RCDPEFTL",90,0) .. S RCEFT("Trans#")=$$GET1^DIQ(344.31,RCEFT("IEN"),.01,"E") ;(#.01) EFT TRANSACTION [1P:344.3] "RTN","RCDPEFTL",91,0) .. S RCEFT("ERARecord")=$$GET1^DIQ(344.31,RCEFT("IEN"),.1) ;(#.1) ERA RECORD [10P:344.4] "RTN","RCDPEFTL",92,0) .. S:RCEFT("ERARecord")="" RCEFT("ERARecord")="None" "RTN","RCDPEFTL",93,0) .. S RCEFT("Amount")=$$GET1^DIQ(344.31,RCEFT("IEN"),.07) ;(#.07) AMOUNT OF PAYMENT [7N] "RTN","RCDPEFTL",94,0) .. ; Save EFT detail and update totals for report "RTN","RCDPEFTL",95,0) .. S RCEFT("Count")=RCEFT("Count")+1 "RTN","RCDPEFTL",96,0) .. S ^TMP("RCDPE_EFTL",$J,RCEFT("Count"))=RCEFT("Trans#")_U_RCEFT("MatchStatus")_U_RCEFT("DaysAged")_U_RCEFT("ERARecord")_U_RECVDT_U_RCEFT("Amount")_U_RCEFT("Trace#") "RTN","RCDPEFTL",97,0) .. S ^TMP("RCDPE_EFTL",$J,"EFT count")=RCEFT("Count") "RTN","RCDPEFTL",98,0) .. S ^TMP("RCDPE_EFTL",$J,"Total Amt")=^TMP("RCDPE_EFTL",$J,"Total Amt")+RCEFT("Amount") "RTN","RCDPEFTL",99,0) ; "RTN","RCDPEFTL",100,0) Q "RTN","RCDPEFTL",101,0) ; "RTN","RCDPEFTL",102,0) RPTOUT(RCINPT) ; Output the report to paper/screen or excel "RTN","RCDPEFTL",103,0) ; Input: RCINPT "RTN","RCDPEFTL",104,0) ; Output: OUTPUT "RTN","RCDPEFTL",105,0) N A,B,DATA,RCRPRT "RTN","RCDPEFTL",106,0) ; RCRPRT - array used for report "RTN","RCDPEFTL",107,0) S RCRPRT("LineCount")=0,RCRPRT("Page")=1 ; Initialize Line/Page counters "RTN","RCDPEFTL",108,0) S RCRPRT("RunDate")=$$FMTE^XLFDT($$NOW^XLFDT) "RTN","RCDPEFTL",109,0) S RCRPRT("ExcelFrmt?")=RCINPT("2Excel?") "RTN","RCDPEFTL",110,0) S RCRPRT("Exit")=0,RCRPRT("ListCntr")=0 "RTN","RCDPEFTL",111,0) ; create lines 2-4 in the header "RTN","RCDPEFTL",112,0) S RCRPRT("HeaderLine",2)="Sorted by Aged Days, Comment: "_$S(RCINPT(344.61,24)]"":RCINPT(344.61,24),1:"None") "RTN","RCDPEFTL",113,0) ; place user's name on the right edge of line 3 "RTN","RCDPEFTL",114,0) S A="Medical Override Date: "_$S(RCINPT(344.61,20)]"":RCINPT(344.61,20),1:"None"),B=" User: "_$S(RCINPT(344.61,22)]"":RCINPT(344.61,22),1:"None"),$E(A,IOM-$L(B)+1,IOM)=B "RTN","RCDPEFTL",115,0) S RCRPRT("HeaderLine",3)=A "RTN","RCDPEFTL",116,0) S RCRPRT("HeaderLine",4)="Number of Days (Age) of Unposted EFTs to prevent posting: "_$$GET1^DIQ(344.61,1,.06) "RTN","RCDPEFTL",117,0) S RCRPRT("HeaderBorder")=$TR($J(" ",IOM-1)," ","=") ; row of equal signs for border "RTN","RCDPEFTL",118,0) I RCRPRT("ExcelFrmt?") W !,"EFT^Match Status^Aged Days^ERA #^Date Received^Amount^Trace #" "RTN","RCDPEFTL",119,0) I 'RCRPRT("ExcelFrmt?") D RPTHDR(.RCRPRT),RPTTOT S RCRPRT("LineCount")=11 "RTN","RCDPEFTL",120,0) ; "RTN","RCDPEFTL",121,0) F S RCRPRT("ListCntr")=$O(^TMP("RCDPE_EFTL",$J,RCRPRT("ListCntr"))) Q:'RCRPRT("ListCntr") D Q:RCRPRT("Exit") "RTN","RCDPEFTL",122,0) . S DATA=$G(^TMP("RCDPE_EFTL",$J,RCRPRT("ListCntr"))) "RTN","RCDPEFTL",123,0) . ; Output lines for one EFT "RTN","RCDPEFTL",124,0) . S RCRPRT("Exit")=$$RPRT1EFT(DATA,.RCRPRT) "RTN","RCDPEFTL",125,0) ; "RTN","RCDPEFTL",126,0) I 'RCRPRT("ExcelFrmt?") W:'RCRPRT("Exit") !,RCRPRT("HeaderBorder"),!,$$ENDORPRT^RCDPEARL "RTN","RCDPEFTL",127,0) I RCRPRT("ExcelFrmt?"),$E(IOST,1,2)="C-" D ; if Excel format and user terminal, pause "RTN","RCDPEFTL",128,0) . N DIR S DIR(0)="EA",DIR("A")="Press ENTER to continue: ",DIR("A",1)=" " D ^DIR "RTN","RCDPEFTL",129,0) Q "RTN","RCDPEFTL",130,0) ; "RTN","RCDPEFTL",131,0) RPRT1EFT(DATA,RCRPRT) ; boolean function, Output one EFT record "RTN","RCDPEFTL",132,0) ; Input: "RTN","RCDPEFTL",133,0) ; DATA - EFT to write, See REPORT for a complete description "RTN","RCDPEFTL",134,0) ; RCRPRT("ExcelFrmt?"): zero - formatted Output to Screen /printer "RTN","RCDPEFTL",135,0) ; 1 - Output in Excel format "RTN","RCDPEFTL",136,0) ; RCRPRT("LineCount") - Line Count "RTN","RCDPEFTL",137,0) ; RCRPRT("Page") - Page Count "RTN","RCDPEFTL",138,0) ; Output: "RTN","RCDPEFTL",139,0) ; RCRPRT("LineCount") - Updated Line Count "RTN","RCDPEFTL",140,0) ; RCRPRT("Page") - Updated Page Count "RTN","RCDPEFTL",141,0) ; Returns: "RTN","RCDPEFTL",142,0) ; 1 if user indicates to quit, 0 otherwise "RTN","RCDPEFTL",143,0) N STOP "RTN","RCDPEFTL",144,0) I RCRPRT("ExcelFrmt?") D Q 0 ; Excel output, format date received, write record and quit "RTN","RCDPEFTL",145,0) . N X,Y S Y=DATA,X=$$FMTE^XLFDT($P(DATA,U,5),"5DZ"),$P(Y,U,5)=X "RTN","RCDPEFTL",146,0) . S RCRPRT("LineCount")=RCRPRT("LineCount")+1 W !,Y "RTN","RCDPEFTL",147,0) ; screen /printer output "RTN","RCDPEFTL",148,0) S STOP=0 ; stop output flag "RTN","RCDPEFTL",149,0) I $E(IOST,1,2)="C-",'(RCRPRT("LineCount")+3END Q:RET D "RTN","RCDPEFTL",218,0) . S EFTDA="" "RTN","RCDPEFTL",219,0) . ; Scan individual EFTs "RTN","RCDPEFTL",220,0) . F S EFTDA=$O(^RCY(344.31,"ADR",RECVDT,EFTDA)) Q:'EFTDA D "RTN","RCDPEFTL",221,0) .. ; Check this is a valid EFT type "RTN","RCDPEFTL",222,0) .. Q:'$$VALID(EFTDA) "RTN","RCDPEFTL",223,0) .. ; Calculate aged number of days of the EFT "RTN","RCDPEFTL",224,0) .. S AGED=$$FMDIFF^XLFDT(DT,RECVDT) "RTN","RCDPEFTL",225,0) .. ; Unposted EFT found older than aged days allowed "RTN","RCDPEFTL",226,0) .. I AGED>LIMIT S RET=RECVDT "RTN","RCDPEFTL",227,0) ; "RTN","RCDPEFTL",228,0) Q RET "RTN","RCDPEFTL",229,0) ; "RTN","RCDPEFTL",230,0) VALID(EFTDA) ; Check if EFT is a valid candidate "RTN","RCDPEFTL",231,0) ; Ignore zero payment amts "RTN","RCDPEFTL",232,0) Q:+$$GET1^DIQ(344.31,EFTDA,.07)=0 0 "RTN","RCDPEFTL",233,0) ; Ignore duplicate EFTs which have been removed "RTN","RCDPEFTL",234,0) Q:$$GET1^DIQ(344.31,EFTDA,.18)]"" 0 "RTN","RCDPEFTL",235,0) ; ERA RECORD (344.31, .1) pointer to ERA record "RTN","RCDPEFTL",236,0) S RCEFT("ERARecord")=$$GET1^DIQ(344.31,EFTDA,.1) "RTN","RCDPEFTL",237,0) ; DETAIL POST STATUS (344.4, .14); ignore posted ERA-EFTs "RTN","RCDPEFTL",238,0) I RCEFT("ERARecord"),$$GET1^DIQ(344.4,RCEFT("ERARecord"),.14,"I")=1 Q 0 "RTN","RCDPEFTL",239,0) ; Ignore EFT matched to Pharmacy ERA "RTN","RCDPEFTL",240,0) I RCEFT("ERARecord"),$$PHARM^RCDPEWLP(RCEFT("ERARecord")) Q 0 "RTN","RCDPEFTL",241,0) ; Exclude EFT matched to Paper EOB if receipt is processed "RTN","RCDPEFTL",242,0) I 'RCEFT("ERARecord"),($$GET1^DIQ(344.31,EFTDA,.08,"I")=2) Q:$$PROC^RCDPEWLP(EFTDA) 0 "RTN","RCDPEFTL",243,0) ; Otherwise valid "RTN","RCDPEFTL",244,0) Q 1 "RTN","RCDPEFTL",245,0) ; "RTN","RCDPEFTL",246,0) PAD(A,N) ; pad A with spaces to length N "RTN","RCDPEFTL",247,0) Q A_$J(" ",N-$L(A)) ; always add at least one trailing space "RTN","RCDPEFTL",248,0) ; "RTN","RCDPEM2") 0^16^B146585710 "RTN","RCDPEM2",1,0) RCDPEM2 ;ALB/TMK/PJH - MANUAL ERA AND EFT MATCHING ;Jun 11, 2014@13:24:36 "RTN","RCDPEM2",2,0) ;;4.5;Accounts Receivable;**173,208,276,284,293,298,303,304,321,326,332**;Mar 20, 1995;Build 40 "RTN","RCDPEM2",3,0) ;;Per VA Directive 6402, this routine should not be modified. "RTN","RCDPEM2",4,0) Q "RTN","RCDPEM2",5,0) ; "RTN","RCDPEM2",6,0) ; PRCA*4.5*303 - Manually Match EFT from Worklist screen "RTN","RCDPEM2",7,0) ; "RTN","RCDPEM2",8,0) MATCHWL ; Manually 'match' ERA to an EFT that originates from [RCDPE WORKLIST ERA LIST] "RTN","RCDPEM2",9,0) N DA,DIC,DIE,DIR,DR,DTRNG,DTOUT,DUOUT,EFTTOT,END,ERATOT,RCEFT,RCERA,RCMBG,RCMATCH,RCNAME,RCQUIT,START,X,Y "RTN","RCDPEM2",10,0) D FULL^VALM1 "RTN","RCDPEM2",11,0) ; PRCA*4.5*332 - Begin modified code block "RTN","RCDPEM2",12,0) S RCMBG=VALMBG "RTN","RCDPEM2",13,0) S RCERA=$$SEL^RCDPEWL7() ; Select ERA to use from screen "RTN","RCDPEM2",14,0) I RCERA=0 D MWQ Q "RTN","RCDPEM2",15,0) ; "RTN","RCDPEM2",16,0) ; Save the line, we need it when we go back to the worklist. "RTN","RCDPEM2",17,0) S RCERA(0)=^RCY(344.4,RCERA,0) ; Get the zero node for this ERA "RTN","RCDPEM2",18,0) I ((+($P(RCERA(0),U,9)))>0)!($P(RCERA(0),U,8)'="") D Q ; PRCA*4.5*326 "RTN","RCDPEM2",19,0) . W !,"ERA is already matched please select another ERA..." "RTN","RCDPEM2",20,0) . D WAIT^VALM1 "RTN","RCDPEM2",21,0) . D MWQ "RTN","RCDPEM2",22,0) D EN^RCDPEE(RCERA) ; Select EFT by partial matches? "RTN","RCDPEM2",23,0) D MWQ "RTN","RCDPEM2",24,0) Q "RTN","RCDPEM2",25,0) ; PRCA*4.5*332 - End modified code block "RTN","RCDPEM2",26,0) ; "RTN","RCDPEM2",27,0) GETDINFO(RCEFT,DEPNUM,DEPDT) ;EP from RCDPEE "RTN","RCDPEM2",28,0) ; Get the Deposit Date and Deposit Number for the specified EFT "RTN","RCDPEM2",29,0) ; Input: RCEFT - IEN for file #344.31 "RTN","RCDPEM2",30,0) ; Output: DEPNUM - Deposit Number (#344.3, .06) "RTN","RCDPEM2",31,0) ; DEPDT - Deposit Date (#344.3, .07) "RTN","RCDPEM2",32,0) N IEN3443 "RTN","RCDPEM2",33,0) S IEN3443=$$GET1^DIQ(344.31,RCEFT_",",.01,"I") ; IEN for file 344.3 "RTN","RCDPEM2",34,0) S DEPNUM=$$GET1^DIQ(344.3,IEN3443_",",.06,"E") ; Deposit Number "RTN","RCDPEM2",35,0) S DEPDT=$$GET1^DIQ(344.3,IEN3443_",",.07,"E") ; Deposit Number "RTN","RCDPEM2",36,0) Q "RTN","RCDPEM2",37,0) ; "RTN","RCDPEM2",38,0) ; Quit back to the worklist VALMBCK will be killed by List Manager. "RTN","RCDPEM2",39,0) ; Rebuild the screen because we may have changed it. "RTN","RCDPEM2",40,0) MWQ D INIT^RCDPEWL7 "RTN","RCDPEM2",41,0) S VALMBCK="R",VALMBG=RCMBG "RTN","RCDPEM2",42,0) Q "RTN","RCDPEM2",43,0) ; "RTN","RCDPEM2",44,0) MATCH1 ; Manually 'match' an ERA to an EFT "RTN","RCDPEM2",45,0) N DA,DIC,DIE,DIR,DIROUT,DR,DTRNG,DTOUT,DUOUT,EFTTOT,END,ERATOT "RTN","RCDPEM2",46,0) N RCEFT,RCERA,RCMATCH,RCMTFLG,RCNAME,RCQUIT,START,X,XX,Y,YY "RTN","RCDPEM2",47,0) W !,"THIS OPTION WILL ALLOW YOU TO MANUALLY MATCH AN EFT DETAIL RECORD" "RTN","RCDPEM2",48,0) W !,"WITH AN ERA RECORD." "RTN","RCDPEM2",49,0) ;S XX=$$PMATCH(RCERA) "RTN","RCDPEM2",50,0) ; PRCA*4.5*298 - Add ability to specify a date range "RTN","RCDPEM2",51,0) S DIR("A")="Select by date Range? (Y/N) ",DIR(0)="YA",DIR("B")="NO" "RTN","RCDPEM2",52,0) D ^DIR K DIR "RTN","RCDPEM2",53,0) I $D(DUOUT)!$D(DTOUT) G M1Q "RTN","RCDPEM2",54,0) I Y<1 G M1 "RTN","RCDPEM2",55,0) S DTRNG=Y ; flag indicating date range selected "RTN","RCDPEM2",56,0) K DIR "RTN","RCDPEM2",57,0) S DIR("?")="Enter the earliest date for the selection range." "RTN","RCDPEM2",58,0) ; value in DIR(0) for %DT = APE: ask date, past assumed, echo answer "RTN","RCDPEM2",59,0) S DIR(0)="DAO^:"_DT_":APE",DIR("A")="Start Date: " "RTN","RCDPEM2",60,0) D ^DIR K DIR "RTN","RCDPEM2",61,0) I $D(DTOUT)!$D(DUOUT)!(Y="") G M1Q "RTN","RCDPEM2",62,0) S START=Y "RTN","RCDPEM2",63,0) K DIR,X,Y "RTN","RCDPEM2",64,0) S DIR("?")="Enter the latest date for the selection range." "RTN","RCDPEM2",65,0) S DIR(0)="DAO^"_START_":"_DT_":APE",DIR("A")="End Date: ",DIR("B")=$$FMTE^XLFDT(DT) "RTN","RCDPEM2",66,0) D ^DIR K DIR "RTN","RCDPEM2",67,0) I $D(DTOUT)!$D(DUOUT)!(Y="") G M1Q "RTN","RCDPEM2",68,0) S END=Y "RTN","RCDPEM2",69,0) ; "RTN","RCDPEM2",70,0) ; Replace DIR with DIC call for EFT line identifier - PRCA*4.5*326 "RTN","RCDPEM2",71,0) M1 S DIC("A")="SELECT THE UNMATCHED EFT TO MATCH TO AN ERA: " "RTN","RCDPEM2",72,0) ; "RTN","RCDPEM2",73,0) ; start PRCA*4.5*293 Add extra checks to filter out EFTs that have "RTN","RCDPEM2",74,0) ; a payment amount of zero or EFTs that have been removed. "RTN","RCDPEM2",75,0) ; Only UNMATCHED EFTs with payment amt >0 and not removed should "RTN","RCDPEM2",76,0) ; be selectable by the user. "RTN","RCDPEM2",77,0) ; "RTN","RCDPEM2",78,0) N DEPDT,DEPNUM "RTN","RCDPEM2",79,0) S DIC("W")="D DICW^RCDPEM3" "RTN","RCDPEM2",80,0) S DIC(0)="AEMQ" "RTN","RCDPEM2",81,0) S DIC=344.31 "RTN","RCDPEM2",82,0) S DIC("S")="I ('$P(^(0),U,8))&($P($G(^(0)),U,7))&('$P($G(^(3)),U))" "RTN","RCDPEM2",83,0) S:$G(DTRNG) DIC("S")=DIC("S")_"&'($P($G(^(0)),U,13)END)" "RTN","RCDPEM2",84,0) ; end PRCA*4.5*293 "RTN","RCDPEM2",85,0) ; "RTN","RCDPEM2",86,0) W ! "RTN","RCDPEM2",87,0) D ^DIC K DIC "RTN","RCDPEM2",88,0) I $D(DUOUT)!$D(DTOUT)!(Y<0) G M1Q "RTN","RCDPEM2",89,0) S RCEFT=+Y "RTN","RCDPEM2",90,0) D GETDINFO(RCEFT,.DEPNUM,.DEPDT) "RTN","RCDPEM2",91,0) W ! "RTN","RCDPEM2",92,0) S DIC="^RCY(344.31,",DR="0",DA=RCEFT D EN^DIQ "RTN","RCDPEM2",93,0) W " DEPOSIT NUMBER: ",DEPNUM,?40,"DEPOSIT DATE: ",DEPDT "RTN","RCDPEM2",94,0) W ! "RTN","RCDPEM2",95,0) S DIR("A")="ARE YOU SURE THIS IS THE EFT YOU WANT TO MATCH?: " "RTN","RCDPEM2",96,0) S DIR(0)="YA",DIR("B")="YES" "RTN","RCDPEM2",97,0) D ^DIR K DIR "RTN","RCDPEM2",98,0) I $D(DUOUT)!$D(DTOUT) G M1Q "RTN","RCDPEM2",99,0) I Y'=1 G M1 "RTN","RCDPEM2",100,0) ; Add EFT line identifier - PRCA*4.5*326 "RTN","RCDPEM2",101,0) M12 S DIR("A")="SELECT THE UNMATCHED ERA TO MATCH TO EFT #" ; PRCA*4.5*326 "RTN","RCDPEM2",102,0) S DIR("A")=DIR("A")_$$GET1^DIQ(344.31,RCEFT,.01,"E")_": " ; PRCA*4.5*326 "RTN","RCDPEM2",103,0) S DIR(0)="PAO^RCY(344.4,:AEMQ",DIR("S")="I '$P(^(0),U,9),'$P(^(0),U,8)" "RTN","RCDPEM2",104,0) W ! D ^DIR K DIR "RTN","RCDPEM2",105,0) I $D(DUOUT)!$D(DTOUT)!(Y<0) G M1Q "RTN","RCDPEM2",106,0) S RCERA=+Y "RTN","RCDPEM2",107,0) W ! "RTN","RCDPEM2",108,0) S DIC="^RCY(344.4,",DR="0",DA=RCERA D EN^DIQ "RTN","RCDPEM2",109,0) W ! "RTN","RCDPEM2",110,0) S DIR("A")="ARE YOU SURE THIS IS THE CORRECT ERA TO MATCH TO?: ",DIR(0)="YA",DIR("B")="YES" D ^DIR K DIR "RTN","RCDPEM2",111,0) I $D(DUOUT)!$D(DTOUT) G M1Q "RTN","RCDPEM2",112,0) I Y'=1 G M12 "RTN","RCDPEM2",113,0) ; "RTN","RCDPEM2",114,0) M12A ; PRCA*4.5*303 - MATCH WL jumps here to complete the manual match "RTN","RCDPEM2",115,0) ; BEGIN PRCA*4.5*326 "RTN","RCDPEM2",116,0) S ERATOT=$$GET1^DIQ(344.4,RCERA,.05,"I") ; ERA Paid Amount "RTN","RCDPEM2",117,0) S EFTTOT=$$GET1^DIQ(344.31,RCEFT,.07,"I") ; EFT Amount of Payment "RTN","RCDPEM2",118,0) S RCMATCH=(+ERATOT=+EFTTOT) ; Do the Totals Match "RTN","RCDPEM2",119,0) ; "RTN","RCDPEM2",120,0) ; If the totals don't match, manual match is not allowed "RTN","RCDPEM2",121,0) ;I 'RCMATCH D G M1Q "RTN","RCDPEM2",122,0) ;. W !,*7,$J("",3)_"> The amount of payment on these two records do not agree." "RTN","RCDPEM2",123,0) ;. K DIR S DIR(0)="EA",DIR("A")="Press ENTER to continue: " "RTN","RCDPEM2",124,0) ;. D ^DIR "RTN","RCDPEM2",125,0) ;. S RCQUIT=1 "RTN","RCDPEM2",126,0) ; "RTN","RCDPEM2",127,0) S XX=$$GET1^DIQ(344.4,RCERA,.06,"I") ; ERA Payer Name "RTN","RCDPEM2",128,0) S YY=$$GET1^DIQ(344.31,RCEFT,.02,"I") ; EFT Payer Name "RTN","RCDPEM2",129,0) S RCNAME=(XX=YY) ; Do the Payer Names Match "RTN","RCDPEM2",130,0) I 'RCNAME D G:RCQUIT M1Q "RTN","RCDPEM2",131,0) . N Z "RTN","RCDPEM2",132,0) . S RCQUIT=0,Z=1 "RTN","RCDPEM2",133,0) . S DIR("A",1)="***WARNING***" "RTN","RCDPEM2",134,0) . I 'RCNAME S Z=Z+1,DIR("A",Z)=$J("",3)_"> The payer names on these two records do not agree" "RTN","RCDPEM2",135,0) . S DIR(0)="YA",DIR("B")="NO",DIR("A")="ARE YOU SURE YOU WANT TO MATCH THESE 2 RECORDS?: " "RTN","RCDPEM2",136,0) . W ! D ^DIR K DIR "RTN","RCDPEM2",137,0) . I $S($D(DUOUT)!$D(DTOUT):1,Y'=1:1,1:0) S RCQUIT=1 Q "RTN","RCDPEM2",138,0) ; END PRCA*4.5*326 "RTN","RCDPEM2",139,0) S DIE="^RCY(344.4,",DR=".09////1",DA=RCERA D ^DIE "RTN","RCDPEM2",140,0) I '$D(Y) S DIE="^RCY(344.31,",DR=".08////1;.1////"_RCERA,DA=RCEFT D ^DIE "RTN","RCDPEM2",141,0) S RCMTFLG=$S('$D(Y):1,1:0) "RTN","RCDPEM2",142,0) ; PRCA*4.5*326 - Add EFT suffix "RTN","RCDPEM2",143,0) W !,"EFT #"_$$GET1^DIQ(344.31,RCEFT,.01,"E")_" WAS "_$S(RCMTFLG:"SUCCESSFULLY",1:"NOT")_" MATCHED TO ERA #"_RCERA ; PRCA*4.5*326 "RTN","RCDPEM2",144,0) I 'RCMTFLG S DIR(0)="E" D ^DIR K DIR G M1Q "RTN","RCDPEM2",145,0) ;PRCA*4.5*304 add ability to use auto-posting for a manually matched item "RTN","RCDPEM2",146,0) ; Only if the amount of payments match. "RTN","RCDPEM2",147,0) I 'RCMATCH D G M1Q ;if payment amounts don't match, don't allow for auto-posting. "RTN","RCDPEM2",148,0) . W !,"ERA/EFT balances do not match - cannot Mark for Auto-Post. Press any key." S DIR(0)="E" D ^DIR K DIR "RTN","RCDPEM2",149,0) W ! "RTN","RCDPEM2",150,0) K DIR "RTN","RCDPEM2",151,0) S DIR("A")="Do you wish to mark this entry for Auto Posting (Y/N)? " "RTN","RCDPEM2",152,0) S DIR(0)="YA" "RTN","RCDPEM2",153,0) D ^DIR "RTN","RCDPEM2",154,0) I 'Y K DIR S DIR(0)="E" D ^DIR G M1Q "RTN","RCDPEM2",155,0) N AUTOPOST "RTN","RCDPEM2",156,0) S AUTOPOST=$$AUTOCHK2^RCDPEAP1(RCERA,1) ; Allow auto-post for CHK and ACH type ERA - PRCA*4.5*321 "RTN","RCDPEM2",157,0) I AUTOPOST D "RTN","RCDPEM2",158,0) . D SETSTA^RCDPEAP(RCERA,0,"Manual Match: Marked as Auto-Post Candidate") "RTN","RCDPEM2",159,0) . W !,"ERA has been successfully Marked as an Auto-Post CANDIDATE" "RTN","RCDPEM2",160,0) I 'AUTOPOST D "RTN","RCDPEM2",161,0) . D AUDITLOG^RCDPEAP(RCERA,"","Manual Match: Not Marked as Auto-Post Candidate-"_$P(AUTOPOST,U,2)) "RTN","RCDPEM2",162,0) . W !,"ERA was NOT Marked as an Auto-Post CANDIDATE - ",$P(AUTOPOST,U,2) "RTN","RCDPEM2",163,0) K DIR S DIR(0)="E" D ^DIR "RTN","RCDPEM2",164,0) M1Q Q "RTN","RCDPEM2",165,0) ; "RTN","RCDPEM2",166,0) MATCH2 ; Manually 'match' a 0-balance EFT to a paper EOB "RTN","RCDPEM2",167,0) N DUOUT,DTOUT,DA,DR,DIE,DIC,DIR,X,Y,RCEFT,RCRCPT "RTN","RCDPEM2",168,0) W !,"THIS OPTION WILL ALLOW YOU TO MANUALLY MARK A 0-BALANCE EFT DETAIL RECORD",!,"AS MATCHED TO A PAPER EOB" "RTN","RCDPEM2",169,0) ; BEGIN PRCA*4.5*326 "RTN","RCDPEM2",170,0) M2 S DIC("A")="SELECT THE UNMATCHED 0-BALANCE EFT TO MARK AS MATCHED TO PAPER EOB: " "RTN","RCDPEM2",171,0) S DIC("W")="D DICW^RCDPEM3" "RTN","RCDPEM2",172,0) S DIC(0)="AEMQ" "RTN","RCDPEM2",173,0) S DIC("S")="I '$P(^(0),U,8),'$P(^(0),U,7)" "RTN","RCDPEM2",174,0) S DIC=344.31 "RTN","RCDPEM2",175,0) D ^DIC "RTN","RCDPEM2",176,0) ; END PRCA*4.5*326 "RTN","RCDPEM2",177,0) I $D(DUOUT)!$D(DTOUT)!(Y'>0) G M2Q "RTN","RCDPEM2",178,0) S RCEFT=+Y "RTN","RCDPEM2",179,0) W ! "RTN","RCDPEM2",180,0) S DIC="^RCY(344.31,",DR="0",DA=RCEFT D EN^DIQ "RTN","RCDPEM2",181,0) W ! "RTN","RCDPEM2",182,0) S DIR("A")="ARE YOU SURE THIS IS THE EFT YOU WANT TO MARK AS MATCHED?: ",DIR(0)="YA",DIR("B")="YES" D ^DIR K DIR "RTN","RCDPEM2",183,0) I $D(DUOUT)!$D(DTOUT) G M2Q "RTN","RCDPEM2",184,0) I Y'=1 G M2 "RTN","RCDPEM2",185,0) S DIE="^RCY(344.31,",DR=".08////2",DA=RCEFT D ^DIE "RTN","RCDPEM2",186,0) S DIR(0)="EA",DIR("A")="EFT #"_RCEFT_" WAS "_$S('$D(Y):"SUCCESSFULLY",1:"NOT")_" MARKED AS MATCHED TO PAPER EOB" D ^DIR K DIR "RTN","RCDPEM2",187,0) M2Q Q "RTN","RCDPEM2",188,0) ; "RTN","RCDPEM2",189,0) MANTR ; Mark an EFT detail record as 'TR' posted manually "RTN","RCDPEM2",190,0) N DA,DR,DIC,DIE,DIR,X,Y,RCEFT,DUOUT,DTOUT,RCZ0,RCTR,RCHOW "RTN","RCDPEM2",191,0) ; EFT detail cannot be associated with a receipt or TR document "RTN","RCDPEM2",192,0) ; "RTN","RCDPEM2",193,0) W !,"*****",!," YOU SHOULD ONLY USE THIS OPTION IF YOU HAVE AN EFT DETAIL RECORD ON YOUR",!," UNAPPLIED DEPOSIT REPORT WHOSE DETAIL WAS ENTERED ON LINE VIA A TR DOCUMENT",!,"*****",! "RTN","RCDPEM2",194,0) S DIC(0)="AEMQ",DIC("S")="I $P(^(0),U,16)="""",$P(^(0),U,11)",DIC("A")="SELECT THE EFT DETAIL WHOSE 'TR' DOC WAS MANUALLY ENTERED ON LINE: ",DIC="^RCY(344.31," "RTN","RCDPEM2",195,0) W ! D ^DIC K DIC "RTN","RCDPEM2",196,0) I Y'>0 G MANTRQ "RTN","RCDPEM2",197,0) S RCEFT=+Y,RCZ0=$G(^RCY(344.31,RCEFT,0)) "RTN","RCDPEM2",198,0) S DIR(0)="FA^2:30^K:X'?1""TR"".E X",DIR("A")="ENTER THE TR DOC # THAT WAS ENTERED ON-LINE FOR THE EFT DETAIL: " "RTN","RCDPEM2",199,0) W ! D ^DIR K DIR "RTN","RCDPEM2",200,0) I $D(DTOUT)!$D(DUOUT) G MANTRQ "RTN","RCDPEM2",201,0) S RCTR=Y,DR="" "RTN","RCDPEM2",202,0) ; "RTN","RCDPEM2",203,0) I '$P(RCZ0,U,8) D G:RCQUIT MANTRQ ;Unmatched "RTN","RCDPEM2",204,0) . S DIR(0)="SA^E:ELECTRONIC ERA;P:PAPER EOB",DIR("A")="WAS THE EFT DETAIL RECEIVED BY (E)RA or (P)APER EOB?: " W ! D ^DIR K DIR "RTN","RCDPEM2",205,0) . I $D(DTOUT)!$D(DUOUT) S RCQUIT=1 Q "RTN","RCDPEM2",206,0) . S RCHOW=Y,DR="" "RTN","RCDPEM2",207,0) . I RCHOW="E" D "RTN","RCDPEM2",208,0) .. S DR=";.09R;.08////1" "RTN","RCDPEM2",209,0) . I RCHOW="P" D "RTN","RCDPEM2",210,0) .. S DR=";.08////2" "RTN","RCDPEM2",211,0) ; "RTN","RCDPEM2",212,0) S DIR(0)="YA",DIR("B")="NO",DIR("A",1)="THIS WILL MARK EFT DETAIL #: "_RCEFT_" AS MANUALLY POSTED",DIR("A",2)=" USING TR DOC: "_RCTR "RTN","RCDPEM2",213,0) S DIR("A")="ARE YOU SURE YOU WANT TO CONTINUE?: " W ! D ^DIR K DIR "RTN","RCDPEM2",214,0) I Y'=1 D G MANTRQ "RTN","RCDPEM2",215,0) . S DIR(0)="EA",DIR("A")="EFT NOT UPDATED - Press ENTER to continue: " W ! D ^DIR K DIR "RTN","RCDPEM2",216,0) S DIE="^RCY(344.31,",DA=RCEFT,DR=".16R"_DR D ^DIE "RTN","RCDPEM2",217,0) I $D(Y) D "RTN","RCDPEM2",218,0) . S DIE="^RCY(344.31,",DA=RCEFT,DR=".16///@;.08///"_$S($P(RCZ0,U,8)'="":$P(RCZ0,U,8),1:"@") D ^DIE "RTN","RCDPEM2",219,0) . S DIR("A")="EFT NOT UPDATED - Press ENTER to continue: " "RTN","RCDPEM2",220,0) E D "RTN","RCDPEM2",221,0) . S DIR("A")="STATUS UPDATED FOR EFT DETAIL #: "_RCEFT_" - Press ENTER to continue: " "RTN","RCDPEM2",222,0) S DIR(0)="EA" "RTN","RCDPEM2",223,0) W ! D ^DIR K DIR "RTN","RCDPEM2",224,0) ; "RTN","RCDPEM2",225,0) MANTRQ Q "RTN","RCDPEM2",226,0) ; "RTN","RCDPEM2",227,0) CHK() ; Function returns the ien of CHECK/MO payment type "RTN","RCDPEM2",228,0) Q +$O(^RC(341.1,"AC",4,0)) "RTN","RCDPEM2",229,0) ; "RTN","RCDPEM2",230,0) ; "RTN","RCDPEM2",231,0) ; "RTN","RCDPEM2",232,0) MATCH3 ; Manually 'match' a 0-balance ERA that has no check or EFT "RTN","RCDPEM2",233,0) N DUOUT,DTOUT,DA,DR,DIE,DIC,DIR,X,Y,RCERA,RCRCPT "RTN","RCDPEM2",234,0) W !,"THIS OPTION WILL ALLOW YOU TO MANUALLY MARK A 0-BALANCE ERA WITH NO",!,"CHECK OR EFT AS 'MATCH-0 PAYMENT' TO REMOVE IT FROM THE ERA AGING REPORT" "RTN","RCDPEM2",235,0) M3 S DIR("A")="SELECT THE UNMATCHED 0-BALANCE ERA TO MARK AS MATCHED: " "RTN","RCDPEM2",236,0) S DIR(0)="PAO^RCY(344.4,:AEMQ",DIR("S")="I '$P(^(0),U,9),'$P(^(0),U,5)" "RTN","RCDPEM2",237,0) W ! D ^DIR K DIR "RTN","RCDPEM2",238,0) I $D(DUOUT)!$D(DTOUT)!(Y'>0) G M3Q "RTN","RCDPEM2",239,0) S RCERA=+Y "RTN","RCDPEM2",240,0) W ! "RTN","RCDPEM2",241,0) S DIC="^RCY(344.4,",DR="0",DA=RCERA D EN^DIQ "RTN","RCDPEM2",242,0) W ! "RTN","RCDPEM2",243,0) S DIR("A")="ARE YOU SURE THIS IS THE ERA YOU WANT TO MARK AS MATCH-0 PAYMENT? (Y/N) ",DIR(0)="YA",DIR("B")="YES" D ^DIR K DIR "RTN","RCDPEM2",244,0) I $D(DUOUT)!$D(DTOUT) G M3Q "RTN","RCDPEM2",245,0) I Y'=1 G M3 "RTN","RCDPEM2",246,0) S DIE="^RCY(344.4,",DR=".09////3",DA=RCERA D ^DIE "RTN","RCDPEM2",247,0) S DIR(0)="EA",DIR("A")="ERA #"_RCERA_" WAS "_$S('$D(Y):"SUCCESSFULLY",1:"NOT")_" MARKED AS MATCH-0 PAYMENT" D ^DIR K DIR "RTN","RCDPEM2",248,0) M3Q Q "RTN","RCDPEM2",249,0) ; "RTN","RCDPEM2",250,0) UNMATCH ; Used to 'unmatch' an ERA matched in error "RTN","RCDPEM2",251,0) N AUTOPOST,DA,DIC,DIE,DIK,DIR,DIROUT,DR,DTOUT,DUOUTX,RCEFT,RCQUIT,RCWL,X,XX,Y "RTN","RCDPEM2",252,0) S DIC(0)="AEMQ",DIC="^RCY(344.4," "RTN","RCDPEM2",253,0) S DIC("S")="I '$P(^(0),U,8),$S('$P(^(0),U,14):1,1:$P(^(0),U,9)=3),$P(^(0),U,9)" "RTN","RCDPEM2",254,0) D ^DIC K DIC "RTN","RCDPEM2",255,0) Q:Y'>0 "RTN","RCDPEM2",256,0) S RCWL=+Y,RCQUIT=0 "RTN","RCDPEM2",257,0) I $D(^RCY(344.49,RCWL,0)) D Q:RCQUIT "RTN","RCDPEM2",258,0) . S DIR(0)="YA" "RTN","RCDPEM2",259,0) . S XX="THIS ERA ALREADY HAS A SCRATCH PAD ENTRY AND MUST BE DELETED BEFORE IT CAN BE" "RTN","RCDPEM2",260,0) . S DIR("A",1)=XX "RTN","RCDPEM2",261,0) . S DIR("A")="UNMATCHED. DO YOU WANT TO DELETE THE SCRATCH PAD ENTRY FOR THIS ERA NOW? " "RTN","RCDPEM2",262,0) . W ! D ^DIR K DIR "RTN","RCDPEM2",263,0) . I Y'=1 S RCQUIT=1 Q "RTN","RCDPEM2",264,0) . S DIK="^RCY(344.49,",DA=RCWL D ^DIK "RTN","RCDPEM2",265,0) S AUTOPOST="" "RTN","RCDPEM2",266,0) I $O(^RCY(344.31,"AERA",RCWL,0)) S RCEFT=+$O(^(0)) D Q:RCQUIT "RTN","RCDPEM2",267,0) . S AUTOPOST=$$GET1^DIQ(344.4,RCWL_",",4.02,"I") "RTN","RCDPEM2",268,0) . W !!,"THIS ERA IS MATCHED TO EFT #"_$$OUT^RCDPEM3(RCEFT) "RTN","RCDPEM2",269,0) . I AUTOPOST=0 W !,"* WARNING: This ERA will be Un-Marked as an Auto-Post CANDIDATE" "RTN","RCDPEM2",270,0) . S DIR("A")="ARE YOU SURE YOU WANT TO UNMATCH THEM? ",DIR(0)="YA" "RTN","RCDPEM2",271,0) . D ^DIR K DIR "RTN","RCDPEM2",272,0) . I Y'=1 S RCQUIT=1 Q "RTN","RCDPEM2",273,0) . S DIE="^RCY(344.31,",DR=".1///@;.08////0",DA=RCEFT D ^DIE "RTN","RCDPEM2",274,0) . W !,"EFT #"_$$OUT^RCDPEM3(RCEFT)_" IS NOW UNMATCHED",! "RTN","RCDPEM2",275,0) ; PRCA*4.5*326 - If check if unmatched, delete date matched and user "RTN","RCDPEM2",276,0) S DIE="^RCY(344.4,",DR=".09////0;.13///@;.14////0;5.03///@;5.04///@" "RTN","RCDPEM2",277,0) S DA=RCWL "RTN","RCDPEM2",278,0) D ^DIE "RTN","RCDPEM2",279,0) I AUTOPOST=0 D SETSTA^RCDPEAP(RCWL,"@","Unmatch: Removed as Auto-Post Candidate") "RTN","RCDPEM2",280,0) S DIR("A")="ERA HAS BEEN SUCCESSFULLY UNMATCHED - Press ENTER to continue: " "RTN","RCDPEM2",281,0) S DIR(0)="EA" W ! D ^DIR K DIR "RTN","RCDPEM2",282,0) Q "RTN","RCDPEM2",283,0) ; "RTN","RCDPEM2",284,0) ; PRCA*4.5*284 - Changed option name from 'Mark ERA Return to Payer' to 'Remove ERA from Active Worklist' "RTN","RCDPEM2",285,0) RETN ; Entrypoint for Remove ERA from Active Worklist "RTN","RCDPEM2",286,0) N DIR,X,Y,DTOUT,DUOUT,DIC,RCY,DIE,DA,DR,MSG,% "RTN","RCDPEM2",287,0) D OWNSKEY^XUSRB(.MSG,"RCDPE MARK ERA",DUZ) "RTN","RCDPEM2",288,0) I 'MSG(0) W !!,"SORRY, YOU ARE NOT AUTHORIZED TO USE THIS OPTION",!,"This option is locked with RCDPE MARK ERA key.",! S DIR(0)="E" D ^DIR K DIR Q "RTN","RCDPEM2",289,0) W !!,"Use this option to remove an ERA from the EEOB Worklist that should not have" "RTN","RCDPEM2",290,0) W !,"been sent to your site by the payer; or the ERA cannot be removed off the" "RTN","RCDPEM2",291,0) W !,"Worklist using the 'Update ERA Posted Using Paper EOB' option." "RTN","RCDPEM2",292,0) W !!,"This option is only to be used if the paper check has been sent back to the" "RTN","RCDPEM2",293,0) W !,"payer without being deposited. Once removed, the ERA can no longer be" "RTN","RCDPEM2",294,0) W !,"accessed for processing, but can be viewed under the posted Worklist. For" "RTN","RCDPEM2",295,0) W !,"auditing purposes, this option requires the user to enter a reason for" "RTN","RCDPEM2",296,0) W !,"removing the ERA.",! "RTN","RCDPEM2",297,0) S DIC="^RCY(344.4,",DIC(0)="AEMQ",DIC("S")="I '$P(^(0),U,9),'$P(^(0),U,14)" D ^DIC K DIC "RTN","RCDPEM2",298,0) Q:Y'>0 "RTN","RCDPEM2",299,0) S RCY=+Y "RTN","RCDPEM2",300,0) S DIR(0)="YA",DIR("A",1)="THIS WILL REMOVE THE ERA # "_+Y_" FROM THE ACTIVE WORKLIST",DIR("A")="ARE YOU SURE YOU WANT TO CONTINUE? " W ! D ^DIR K DIR "RTN","RCDPEM2",301,0) W ! "RTN","RCDPEM2",302,0) I $D(DUOUT)!$D(DTOUT)!(Y=0) D NOCHNG^RCDPEMB Q "RTN","RCDPEM2",303,0) S DIE="^RCY(344.4,",DA=RCY,DR=".18" D ^DIE "RTN","RCDPEM2",304,0) I $D(Y) D NOCHNG^RCDPEMB Q "RTN","RCDPEM2",305,0) ; PRCA*4.5*284 Set EFT MATCH STATUS (#344.4,.09) as '4' FOR REMOVED rather than '2' FOR MATCHED TO PAPER CHECK "RTN","RCDPEM2",306,0) D NOW^%DTC S DR=".14////4;.09////4;.16////"_DUZ_";.17////"_% D ^DIE "RTN","RCDPEM2",307,0) S DIR(0)="EA",DIR("A")="Press ENTER to continue: " "RTN","RCDPEM2",308,0) W ! D ^DIR "RTN","RCDPEM2",309,0) Q "RTN","RCDPEM4") 0^41^B215421276 "RTN","RCDPEM4",1,0) RCDPEM4 ;OIFO-BAYPINES/PJH - EPAYMENTS AUDIT REPORTS ;Nov 17, 2014@17:00:41 "RTN","RCDPEM4",2,0) ;;4.5;Accounts Receivable;**276,284,298,304,321,326,332**;Mar 20, 1995;Build 40 "RTN","RCDPEM4",3,0) ;Per VA Directive 6402, this routine should not be modified. "RTN","RCDPEM4",4,0) ; "RTN","RCDPEM4",5,0) EOB ; EEOB Move/Copy/Rmove Audit Report [RCDPE EEOB MOVE/COPY/RMOVE RPT] "RTN","RCDPEM4",6,0) N RCRTYP S RCRTYP="EOB" ; record type "RTN","RCDPEM4",7,0) D ASKUSR "RTN","RCDPEM4",8,0) Q "RTN","RCDPEM4",9,0) ; "RTN","RCDPEM4",10,0) POST ; ERAs Posted with Paper EOB Audit Report [RCDPE ERA W/PAPER EOB REPORT] "RTN","RCDPEM4",11,0) N RCRTYP S RCRTYP="ERA" ; record type "RTN","RCDPEM4",12,0) D ASKUSR "RTN","RCDPEM4",13,0) Q "RTN","RCDPEM4",14,0) ; "RTN","RCDPEM4",15,0) ASKUSR ;collect filter and device options "RTN","RCDPEM4",16,0) Q:$G(RCRTYP)="" ; must have record type "RTN","RCDPEM4",17,0) N %ZIS,POP,RCACT,RCDISPTY,RCDIV,RCDTRNG,RCHDR,RCLSTMGR,RCLNCNT,RCPGNUM,RCPROG,RCSTA,RCSTOP "RTN","RCDPEM4",18,0) N RCTMPND,RCTYPE,VAUTD,X,Y "RTN","RCDPEM4",19,0) ; RCACT - selected actions for EOB "RTN","RCDPEM4",20,0) ; RCDISPTY - display type "RTN","RCDPEM4",21,0) ; RCDIV - selected divs. "RTN","RCDPEM4",22,0) ; RCDTRNG - date range for report "RTN","RCDPEM4",23,0) ; RCHDR - header array "RTN","RCDPEM4",24,0) ; RCLSTMGR - ListMan output flag "RTN","RCDPEM4",25,0) ; RCPGNUM - report page count "RTN","RCDPEM4",26,0) ; RCPROG - ^TMP storage node for entries "RTN","RCDPEM4",27,0) ; RCSTA - station "RTN","RCDPEM4",28,0) ; RCSTOP - flag to stop report "RTN","RCDPEM4",29,0) ; RCTMPND - ListMan storage node "RTN","RCDPEM4",30,0) ; RCTYPE - Type of EEOBs to include M/P/T/A MEDICAL/PHARMACY/TRICARE/ALL "RTN","RCDPEM4",31,0) ; "RTN","RCDPEM4",32,0) S RCPROG=$T(+0),RCLSTMGR="",RCACT="",(RCLNCNT,RCSTOP)=0,RCTMPND="" "RTN","RCDPEM4",33,0) ; S (RCXCLUDE("CHAMPVA"),RCXCLUDE("TRICARE"))=0 ; default to false "RTN","RCDPEM4",34,0) ;Select Date Range for Report "RTN","RCDPEM4",35,0) S RCDTRNG=$$DTRNG() G:'RCDTRNG EXIT "RTN","RCDPEM4",36,0) ;Select Filter for Action Type (Move,Copy,Remove or All) "RTN","RCDPEM4",37,0) I RCRTYP="EOB" S RCACT=$$ACTION G:RCACT<0 EXIT "RTN","RCDPEM4",38,0) ;Select Filter/Sort by Division "RTN","RCDPEM4",39,0) D STADIV G:'RCDIV EXIT "RTN","RCDPEM4",40,0) ; Begin PRCA*4.5*326 Tricare filter "RTN","RCDPEM4",41,0) S RCTYPE=$$RTYPE^RCDPEU1("A") I RCTYPE=-1 G EXIT "RTN","RCDPEM4",42,0) ; "RTN","RCDPEM4",43,0) ; Select Display Type , exit if indicated "RTN","RCDPEM4",44,0) S RCDISPTY=$$DISPTY() G:RCDISPTY<0 EXIT "RTN","RCDPEM4",45,0) ;Display capture information for Excel, set RCLSTMGR to prevent question "RTN","RCDPEM4",46,0) I RCDISPTY D INFO^RCDPEM6 S RCLSTMGR="^" "RTN","RCDPEM4",47,0) I RCLSTMGR="" S RCLSTMGR=$$ASKLM^RCDPEARL G:RCLSTMGR<0 EXIT "RTN","RCDPEM4",48,0) I RCLSTMGR D G EXIT "RTN","RCDPEM4",49,0) .X "S RCTMPND=$T(+0)_U_$$HDR"_RCRTYP K ^TMP($J,RCTMPND) ; ^TMP storage node, clean any residue "RTN","RCDPEM4",50,0) .D RPRTCMPL "RTN","RCDPEM4",51,0) .N H,L,HDR S L=0 "RTN","RCDPEM4",52,0) .X "S HDR(""TITLE"")=$$HDR"_RCRTYP "RTN","RCDPEM4",53,0) .F H=1:1:7 I $D(RCHDR(H)) S L=H,HDR(H)=RCHDR(H) ; take first 7 lines of report header "RTN","RCDPEM4",54,0) .I $O(RCHDR(L)) D ; any remaining header lines at top of report "RTN","RCDPEM4",55,0) ..N N S N=0,H=L F S H=$O(RCHDR(H)) Q:'H S N=N+.001,^TMP($J,RCTMPND,N)=RCHDR(H) "RTN","RCDPEM4",56,0) .; invoke ListMan "RTN","RCDPEM4",57,0) .D LMRPT^RCDPEARL(.HDR,$NA(^TMP($J,RCTMPND))) ; generate ListMan display "RTN","RCDPEM4",58,0) ; "RTN","RCDPEM4",59,0) ;Select output device "RTN","RCDPEM4",60,0) S %ZIS="QM" D ^%ZIS Q:POP "RTN","RCDPEM4",61,0) ;Option to queue "RTN","RCDPEM4",62,0) I 'RCDISPTY,$D(IO("Q")) D Q "RTN","RCDPEM4",63,0) .N ZTSK,ZTDESC,ZTSAVE,ZTQUEUED,ZTRTN "RTN","RCDPEM4",64,0) .S ZTRTN="RPRTCMPL^RCDPEM4" "RTN","RCDPEM4",65,0) .S ZTDESC="EDI LOCKBOX PAPER EOB AUDIT REPORT" "RTN","RCDPEM4",66,0) .S ZTSAVE("RC*")="",ZTSAVE("VAUTD")="" "RTN","RCDPEM4",67,0) .D ^%ZTLOAD "RTN","RCDPEM4",68,0) .W !!,$S($G(ZTSK):"Task number "_ZTSK_" was queued.",1:"Unable to queue this task."),! "RTN","RCDPEM4",69,0) .K ZTSK,IO("Q") D HOME^%ZIS "RTN","RCDPEM4",70,0) ; "RTN","RCDPEM4",71,0) ;Compile and Print Report "RTN","RCDPEM4",72,0) D RPRTCMPL "RTN","RCDPEM4",73,0) Q "RTN","RCDPEM4",74,0) ; "RTN","RCDPEM4",75,0) RPRTCMPL ;Compile and print report "RTN","RCDPEM4",76,0) K ^TMP(RCPROG,$J),^TMP($J,"RC TOTAL") "RTN","RCDPEM4",77,0) ;Scan ERA file for entries in date range "RTN","RCDPEM4",78,0) I RCRTYP="ERA" D CMPLERA "RTN","RCDPEM4",79,0) ;Scan EOB file for entries in date range "RTN","RCDPEM4",80,0) I RCRTYP="EOB" D CMPLEOB "RTN","RCDPEM4",81,0) ;Display Report "RTN","RCDPEM4",82,0) D DISP "RTN","RCDPEM4",83,0) ; "RTN","RCDPEM4",84,0) EXIT ; "RTN","RCDPEM4",85,0) ;Clear old data "RTN","RCDPEM4",86,0) K ^TMP(RCPROG,$J),^TMP($J,"RC TOTAL") "RTN","RCDPEM4",87,0) Q "RTN","RCDPEM4",88,0) ; "RTN","RCDPEM4",89,0) CMPLERA ;Generate the ERA posted with paper EOB report ^TMP array "RTN","RCDPEM4",90,0) ; ^RCY(344.4,0) = ELECTRONIC REMITTANCE ADVICE^344.4I^ "RTN","RCDPEM4",91,0) N START,END,ERAIEN,STA,STNAM,STNUM "RTN","RCDPEM4",92,0) ;Date Range "RTN","RCDPEM4",93,0) S START=0,END="9999999",SUB=0 "RTN","RCDPEM4",94,0) S:$P(RCDTRNG,U) START=$P(RCDTRNG,U,2),END=$P(RCDTRNG,U,3)_".24" ; PRCA*4.5*326 allow for time at end of date range "RTN","RCDPEM4",95,0) ;Selected division or All "RTN","RCDPEM4",96,0) ;Scan AFL index for ERA within date range "RTN","RCDPEM4",97,0) F S START=$O(^RCY(344.4,"AFL",START)) Q:'START Q:START>END D "RTN","RCDPEM4",98,0) .S ERAIEN="" "RTN","RCDPEM4",99,0) .F S ERAIEN=$O(^RCY(344.4,"AFL",START,ERAIEN)) Q:'ERAIEN D "RTN","RCDPEM4",100,0) ..;Ignore if not posted with paper EOB "RTN","RCDPEM4",101,0) ..Q:'$D(^RCY(344.4,ERAIEN,7)) "RTN","RCDPEM4",102,0) ..;Check division "RTN","RCDPEM4",103,0) ..D ERASTA(ERAIEN,.STA,.STNUM,.STNAM) "RTN","RCDPEM4",104,0) ..I RCDIV=2,'$D(VAUTD(STA)) Q "RTN","RCDPEM4",105,0) ..I '$$ISTYPE^RCDPEU1(344.4,ERAIEN,RCTYPE) Q ; PRCA*4.5*326 - M/P/T/A filter "RTN","RCDPEM4",106,0) ..; "RTN","RCDPEM4",107,0) ..D SVERA^RCDPEM41(ERAIEN,STA,STNUM,STNAM) "RTN","RCDPEM4",108,0) ; "RTN","RCDPEM4",109,0) Q "RTN","RCDPEM4",110,0) ; "RTN","RCDPEM4",111,0) CMPLEOB ;Generate the EOB Moved/Copy/Remove report ^TMP array "RTN","RCDPEM4",112,0) N DTSUB,START,END,EOBIEN,IEN101,STA,STNAM,STNUM "RTN","RCDPEM4",113,0) ;Date Range "RTN","RCDPEM4",114,0) S START=$P(RCDTRNG,U,2),END=$P(RCDTRNG,U,3) "RTN","RCDPEM4",115,0) ;Selected division or All "RTN","RCDPEM4",116,0) ;Scan AEOB index for EOB within date range "RTN","RCDPEM4",117,0) F S START=$O(^IBM(361.1,"AEOB",START)) Q:'START Q:(START\1)>END D "RTN","RCDPEM4",118,0) .S EOBIEN="" "RTN","RCDPEM4",119,0) .F S EOBIEN=$O(^IBM(361.1,"AEOB",START,EOBIEN)) Q:'EOBIEN D "RTN","RCDPEM4",120,0) ..; Ignore if not MOVED/COPIED "RTN","RCDPEM4",121,0) ..S IEN101="" F S IEN101=$O(^IBM(361.1,"AEOB",START,EOBIEN,IEN101)) Q:'IEN101 D ; "RTN","RCDPEM4",122,0) ...; Check division "RTN","RCDPEM4",123,0) ...D EOBSTA(EOBIEN,.STA,.STNUM,.STNAM) "RTN","RCDPEM4",124,0) ...I RCDIV=2,'$D(VAUTD(STA)) Q "RTN","RCDPEM4",125,0) ...I '$$ISTYPE^RCDPEU1(361.1,EOBIEN,RCTYPE) Q ; PRCA*4.5*326 - M/P/T/A filter "RTN","RCDPEM4",126,0) ...; "RTN","RCDPEM4",127,0) ...; "RTN","RCDPEM4",128,0) ...D SVEOB^RCDPEM41(EOBIEN,IEN101,STA,STNUM,STNAM) "RTN","RCDPEM4",129,0) ; "RTN","RCDPEM4",130,0) Q "RTN","RCDPEM4",131,0) ; "RTN","RCDPEM4",132,0) DISP ; Format the display for screen/printer or MS Excel "RTN","RCDPEM4",133,0) N DVFLTR,IEN,RCNTRY,SUB,Y "RTN","RCDPEM4",134,0) ;Format Division Filter "RTN","RCDPEM4",135,0) S DVFLTR=$S(RCRTYP="EOB":"ALL STATIONS/DIVISIONS",1:"ALL") I RCDIV=2 S DVFLTR=$$LINE(.VAUTD) "RTN","RCDPEM4",136,0) D:'RCLSTMGR HDRBLD ; Report header "RTN","RCDPEM4",137,0) D:RCLSTMGR HDRLM ; Listman header "RTN","RCDPEM4",138,0) ; RCNTRY - entry from ^TMP(RCPROG,$J) "RTN","RCDPEM4",139,0) ; "RTN","RCDPEM4",140,0) U IO "RTN","RCDPEM4",141,0) ; "RTN","RCDPEM4",142,0) ; Display Header for first time "RTN","RCDPEM4",143,0) D:'RCLSTMGR HDRLST^RCDPEARL(.RCSTOP,.RCHDR) "RTN","RCDPEM4",144,0) ;Report by division or 'ALL' "RTN","RCDPEM4",145,0) S SUB=0,RCSTOP=0 "RTN","RCDPEM4",146,0) F S SUB=$O(^TMP(RCPROG,$J,SUB)) Q:SUB=""!RCSTOP D "RTN","RCDPEM4",147,0) .S IEN=0 F S IEN=$O(^TMP(RCPROG,$J,SUB,IEN)) Q:'IEN!RCSTOP S RCNTRY=^(IEN) D "RTN","RCDPEM4",148,0) ..I RCDISPTY W !,RCNTRY Q ; spreadsheet format "RTN","RCDPEM4",149,0) ..I RCRTYP="ERA" D ; ERA posted with paper EOB "RTN","RCDPEM4",150,0) ...I 'RCLSTMGR,$Y>(IOSL-RCHDR(0)) D HDRLST^RCDPEARL(.RCSTOP,.RCHDR) Q:RCSTOP "RTN","RCDPEM4",151,0) ...S Y=$$PAD^RCDPEARL($P(RCNTRY,U,5),11) ; ERA# "RTN","RCDPEM4",152,0) ...S Y=Y_$$PAD^RCDPEARL($P(RCNTRY,U,6),13) ;RECEIPT# "RTN","RCDPEM4",153,0) ...S Y=Y_$$PAD^RCDPEARL($P(RCNTRY,U,3),18) ;DATE/TIME "RTN","RCDPEM4",154,0) ...S Y=Y_$$PAD^RCDPEARL($P(RCNTRY,U,4),16) ;USER LASTNAME,FIRSTNAME "RTN","RCDPEM4",155,0) ...S Y=Y_$P(RCNTRY,U,7) ;MATCH STATUS "RTN","RCDPEM4",156,0) ...D SL^RCDPEARL(Y,.RCLNCNT,RCTMPND) "RTN","RCDPEM4",157,0) ...D SL^RCDPEARL($J("",61)_$P(RCNTRY,U,8),.RCLNCNT,RCTMPND) ;POST STATUS "RTN","RCDPEM4",158,0) ..; "RTN","RCDPEM4",159,0) ..I RCRTYP="EOB" D ; EOB Moved/Copied "RTN","RCDPEM4",160,0) ...I 'RCLSTMGR,$Y>(IOSL-RCHDR(0)) D HDRLST^RCDPEARL(.RCSTOP,.RCHDR) Q:RCSTOP "RTN","RCDPEM4",161,0) ...S Y=$$PAD^RCDPEARL($P(RCNTRY,U,5),20) ; ORIGINAL BILL "RTN","RCDPEM4",162,0) ...S Y=Y_$P(RCNTRY,U,8) ; TRACE # "RTN","RCDPEM4",163,0) ...D SL^RCDPEARL(Y,.RCLNCNT,RCTMPND) "RTN","RCDPEM4",164,0) ...S Y=$$PAD^RCDPEARL($J("",6)_$P(RCNTRY,U,7),15) ;ERA "RTN","RCDPEM4",165,0) ...S Y=Y_$$PAD^RCDPEARL($P(RCNTRY,U,3),20) ;DATE/TIME "RTN","RCDPEM4",166,0) ...S Y=Y_$$PAD^RCDPEARL($P(RCNTRY,U,12),15) ;MOVED/COPIED/REMOVED "RTN","RCDPEM4",167,0) ...S Y=Y_$$PAD^RCDPEARL("$"_$P(RCNTRY,U,9),11) ;PAYMENT AMOUNT "RTN","RCDPEM4",168,0) ...S Y=Y_$P(RCNTRY,U,4) ; USER LASTNAME,FIRSTNAME "RTN","RCDPEM4",169,0) ...D SL^RCDPEARL(Y,.RCLNCNT,RCTMPND) "RTN","RCDPEM4",170,0) ...D:$P(RCNTRY,U,12)'="REMOVED" "RTN","RCDPEM4",171,0) ....S Y=$$PAD^RCDPEARL("New Bill: "_$P(RCNTRY,U,6),25) ;NEW BILL "RTN","RCDPEM4",172,0) ....S Y=Y_"Other Bill Number(s): "_$P(RCNTRY,U,11) ;OTHER BILLS "RTN","RCDPEM4",173,0) ....D SL^RCDPEARL(Y,.RCLNCNT,RCTMPND) "RTN","RCDPEM4",174,0) ...; "RTN","RCDPEM4",175,0) ...D WP($P(RCNTRY,U,10)) ; Justification comments "RTN","RCDPEM4",176,0) ...D SL^RCDPEARL("",.RCLNCNT,RCTMPND) ; skip a line "RTN","RCDPEM4",177,0) .; "RTN","RCDPEM4",178,0) .; end of report "RTN","RCDPEM4",179,0) .I 'RCSTOP D SL^RCDPEARL(" ",.RCLNCNT,RCTMPND),SL^RCDPEARL($$ENDORPRT^RCDPEARL,.RCLNCNT,RCTMPND) "RTN","RCDPEM4",180,0) ; "RTN","RCDPEM4",181,0) D:'$D(^TMP(RCPROG,$J)) "RTN","RCDPEM4",182,0) .D SL^RCDPEARL(" ",.RCLNCNT,RCTMPND) ; skip line "RTN","RCDPEM4",183,0) .D SL^RCDPEARL(" *** NO RECORDS TO PRINT ***",.RCLNCNT,RCTMPND) "RTN","RCDPEM4",184,0) ; "RTN","RCDPEM4",185,0) ;Close device "RTN","RCDPEM4",186,0) I '$D(ZTQUEUED),'RCLSTMGR D ^%ZISC "RTN","RCDPEM4",187,0) S:$D(ZTQUEUED) ZTREQ="@" "RTN","RCDPEM4",188,0) Q "RTN","RCDPEM4",189,0) ; "RTN","RCDPEM4",190,0) LINE(VAUTD) ;List selected stations "RTN","RCDPEM4",191,0) N LINE,SUB "RTN","RCDPEM4",192,0) S LINE="",SUB="" "RTN","RCDPEM4",193,0) F S SUB=$O(VAUTD(SUB)) Q:'SUB D "RTN","RCDPEM4",194,0) .S LINE=LINE_$G(VAUTD(SUB))_", " "RTN","RCDPEM4",195,0) Q $E(LINE,1,$L(LINE)-2) "RTN","RCDPEM4",196,0) ; "RTN","RCDPEM4",197,0) SELDIV(VAUTD,Z) ;Devisions are organized as Z(1)="DIV1,DIV2,..., Z(2)="DIVN,DIVN+1,... etc. "RTN","RCDPEM4",198,0) ; Input: "RTN","RCDPEM4",199,0) ; VAUTD (required/pass-by-ref) - Division(s) array; result of call to DIVISION^VAUTOMA "RTN","RCDPEM4",200,0) ; Output: "RTN","RCDPEM4",201,0) ; Z (required/pass-by-ref) - reformatted array of divisions "RTN","RCDPEM4",202,0) ; "RTN","RCDPEM4",203,0) N SUB,CNT "RTN","RCDPEM4",204,0) S CNT=1,Z(CNT)="DIVISIONS: " "RTN","RCDPEM4",205,0) I $D(VAUTD)=1 D Q "RTN","RCDPEM4",206,0) . S Z(CNT)=Z(CNT)_"ALL" "RTN","RCDPEM4",207,0) .S Z(CNT)=$J("",80-$L(Z(CNT))\2)_Z(CNT) "RTN","RCDPEM4",208,0) I $D(VAUTD)>1,'VAUTD D "RTN","RCDPEM4",209,0) .S SUB=VAUTD "RTN","RCDPEM4",210,0) .F S SUB=$O(VAUTD(SUB)) Q:'SUB D "RTN","RCDPEM4",211,0) ..I Z(CNT)="DIVISIONS: " S Z(CNT)=Z(CNT)_VAUTD(SUB) Q "RTN","RCDPEM4",212,0) ..S Z(CNT)=Z(CNT)_$S(Z(CNT)]"":",",1:"")_VAUTD(SUB) "RTN","RCDPEM4",213,0) ..I $L(Z(CNT))>50 S Z(CNT)=$J("",80-$L(Z(CNT))\2)_Z(CNT),CNT=CNT+1,Z(CNT)="" "RTN","RCDPEM4",214,0) ; "RTN","RCDPEM4",215,0) I Z(CNT)]"" S Z(CNT)=$J("",80-$L(Z(CNT))\2)_Z(CNT) "RTN","RCDPEM4",216,0) I Z(CNT)="" K Z(CNT) "RTN","RCDPEM4",217,0) Q "RTN","RCDPEM4",218,0) ; "RTN","RCDPEM4",219,0) HDRBLD ; create the report header "RTN","RCDPEM4",220,0) ; returns RCHDR, RCPGNUM, RCSTOP "RTN","RCDPEM4",221,0) ; RCHDR(0) = header text line count "RTN","RCDPEM4",222,0) ; RCHDR("XECUTE") = M code for page number "RTN","RCDPEM4",223,0) ; RCHDR("RUNDATE") = date/time report generated, external format "RTN","RCDPEM4",224,0) ; RCPGNUM - page counter "RTN","RCDPEM4",225,0) ; RCSTOP - flag to exit "RTN","RCDPEM4",226,0) ; INPUT: "RTN","RCDPEM4",227,0) ; RCDISPTY - Display/print/Excel flag "RTN","RCDPEM4",228,0) ; RCDTRNG - date range "RTN","RCDPEM4",229,0) ; RCRTYP - Report Type (EOB or ERA) "RTN","RCDPEM4",230,0) ; VAUTD "RTN","RCDPEM4",231,0) K RCHDR S RCHDR("RUNDATE")=$$NOW^RCDPEARL,RCPGNUM=0,RCSTOP=0 "RTN","RCDPEM4",232,0) ; "RTN","RCDPEM4",233,0) I RCDISPTY D Q ; Excel format, xecute code is QUIT, null page number "RTN","RCDPEM4",234,0) .S RCHDR(0)=1,RCHDR(1)="^^^",RCHDR("XECUTE")="Q",RCPGNUM="" "RTN","RCDPEM4",235,0) .S:RCRTYP="ERA" RCHDR(1)="STATION^STATION NUMBER^DATE/TIME^USER^ERA^RECEIPT^MATCH STATUS^POSTED STATUS" "RTN","RCDPEM4",236,0) .S:RCRTYP="EOB" RCHDR(1)="STATION^STATION NUMBER^DATE/TIME^USER^ORIGINAL BILL^NEW BILL^ERA#^TRACE#^PAYMENT AMOUNT^JUSTIFICATION^OTHER BILLS^MOVED/COPIED" "RTN","RCDPEM4",237,0) ; "RTN","RCDPEM4",238,0) N START,END,MSG,DATE,Y,DIV,HCNT,J "RTN","RCDPEM4",239,0) S START=$$FMTE^XLFDT($P(RCDTRNG,U,2),"2Z"),END=$$FMTE^XLFDT($P(RCDTRNG,U,3),"2Z"),HCNT=0 "RTN","RCDPEM4",240,0) ; "RTN","RCDPEM4",241,0) S RCHDR(0)=0 ; header line count "RTN","RCDPEM4",242,0) X "S Y=$$HDR"_RCRTYP S HCNT=1 "RTN","RCDPEM4",243,0) ; "RTN","RCDPEM4",244,0) I RCRTYP="ERA" D "RTN","RCDPEM4",245,0) .D HDRXEC(RCRTYP) ; xecute code for line 1 "RTN","RCDPEM4",246,0) .S Y="Run Date/Time: "_RCHDR("RUNDATE") "RTN","RCDPEM4",247,0) .S HCNT=HCNT+1,RCHDR(HCNT)=$J("",80-$L(Y)\2)_Y "RTN","RCDPEM4",248,0) .S Y="DIVISIONS: "_$S(VAUTD=1:"ALL",1:DVFLTR) "RTN","RCDPEM4",249,0) .S HCNT=HCNT+1,RCHDR(HCNT)=$J("",80-$L(Y)\2)_Y "RTN","RCDPEM4",250,0) .S Y="Date Range: "_START_" - "_END_" (DATE ERA UPDATED)" "RTN","RCDPEM4",251,0) .S HCNT=HCNT+1,RCHDR(HCNT)=$J("",80-$L(Y)\2)_Y "RTN","RCDPEM4",252,0) .; PRCA*4.5*326 "RTN","RCDPEM4",253,0) .S Y="MEDICAL/PHARMACY/TRICARE: " "RTN","RCDPEM4",254,0) .S Y=Y_$S(RCTYPE="M":"MEDICAL",RCTYPE="P":"PHARMACY",RCTYPE="T":"TRICARE",1:"ALL") "RTN","RCDPEM4",255,0) .S HCNT=HCNT+1,RCHDR(HCNT)=$J("",80-$L(Y)\2)_Y "RTN","RCDPEM4",256,0) .S HCNT=HCNT+1,RCHDR(HCNT)="" "RTN","RCDPEM4",257,0) .S HCNT=HCNT+1,RCHDR(HCNT)=" Date/Time User Who EFT Match Status" "RTN","RCDPEM4",258,0) .S HCNT=HCNT+1,RCHDR(HCNT)="ERA # Receipt # ERA Updated Updated Detail Post Status" "RTN","RCDPEM4",259,0) .S RCHDR(0)=HCNT ; header line count "RTN","RCDPEM4",260,0) ; "RTN","RCDPEM4",261,0) I RCRTYP="EOB" D "RTN","RCDPEM4",262,0) .D HDRXEC(RCRTYP) ; xecute code for line 1 "RTN","RCDPEM4",263,0) .S Y="Run Date/Time: "_RCHDR("RUNDATE") "RTN","RCDPEM4",264,0) .S HCNT=HCNT+1,RCHDR(HCNT)=$J("",80-$L(Y)\2)_Y "RTN","RCDPEM4",265,0) .S Y="Divisions: "_$S(VAUTD=1:"ALL",1:DVFLTR) "RTN","RCDPEM4",266,0) .S HCNT=HCNT+1,RCHDR(HCNT)=$J("",80-$L(Y)\2)_Y "RTN","RCDPEM4",267,0) .S Y="Date Range: "_START_" - "_END_" (Date EEOB was Moved/Copied/Removed)" "RTN","RCDPEM4",268,0) .S HCNT=HCNT+1,RCHDR(HCNT)=$J("",80-$L(Y)\2)_Y "RTN","RCDPEM4",269,0) .; PRCA*4.5*326 "RTN","RCDPEM4",270,0) .S Y="MEDICAL/PHARMACY/TRICARE: " "RTN","RCDPEM4",271,0) .S Y=Y_$S(RCTYPE="M":"MEDICAL",RCTYPE="P":"PHARMACY",RCTYPE="T":"TRICARE",1:"ALL") "RTN","RCDPEM4",272,0) .S HCNT=HCNT+1,RCHDR(HCNT)=$J("",80-$L(Y)\2)_Y "RTN","RCDPEM4",273,0) .S Y=" Action(s) Selected: "_$S(RCACT="M":"MOVE",RCACT="C":"COPY",RCACT="R":"REMOVE",1:"ALL") "RTN","RCDPEM4",274,0) .S HCNT=HCNT+1,RCHDR(HCNT)=$J("",80-$L(Y)\2)_Y "RTN","RCDPEM4",275,0) .S HCNT=HCNT+1,RCHDR(HCNT)="" "RTN","RCDPEM4",276,0) .S HCNT=HCNT+1,RCHDR(HCNT)="Orig Bill# Trace #" "RTN","RCDPEM4",277,0) .S HCNT=HCNT+1,RCHDR(HCNT)=" Moved/Copied/ Total Amt User Who Moved/" "RTN","RCDPEM4",278,0) .S HCNT=HCNT+1,RCHDR(HCNT)=" ERA # Date/Time Removed Paid Copied/Removed" "RTN","RCDPEM4",279,0) .S RCHDR(0)=HCNT ; header line count "RTN","RCDPEM4",280,0) ; "RTN","RCDPEM4",281,0) ; add row of equal signs, not for ListMan "RTN","RCDPEM4",282,0) S Y=RCHDR(0)+1,RCHDR(0)=Y,RCHDR(Y)=$TR($J("",80)," ","=") "RTN","RCDPEM4",283,0) Q "RTN","RCDPEM4",284,0) ; "RTN","RCDPEM4",285,0) HDRLM ; create the Listman header "RTN","RCDPEM4",286,0) ; returns RCHDR "RTN","RCDPEM4",287,0) ; RCHDR(0) = header text line count "RTN","RCDPEM4",288,0) ; INPUT: "RTN","RCDPEM4",289,0) ; RCDTRNG - date range "RTN","RCDPEM4",290,0) ; VAUTD - Division filter value(s) "RTN","RCDPEM4",291,0) N START,END,MSG,DATE,Y,DIV,HCNT,J "RTN","RCDPEM4",292,0) S START=$$FMTE^XLFDT($P(RCDTRNG,U,2),"2Z"),END=$$FMTE^XLFDT($P(RCDTRNG,U,3),"2Z"),HCNT=0 "RTN","RCDPEM4",293,0) ; "RTN","RCDPEM4",294,0) S RCHDR(0)=0 ; header line count "RTN","RCDPEM4",295,0) X "S Y=$$HDR"_RCRTYP "RTN","RCDPEM4",296,0) I RCRTYP="ERA" D "RTN","RCDPEM4",297,0) .D HDRXEC(RCRTYP) ; xecute code for line 1 "RTN","RCDPEM4",298,0) .S HCNT=1,RCHDR(HCNT)="" "RTN","RCDPEM4",299,0) .S Y="Divisions: "_$S(VAUTD=1:"ALL",1:DVFLTR)_" " "RTN","RCDPEM4",300,0) .; PRCA*4.5*326 "RTN","RCDPEM4",301,0) .S Y=Y_"MEDICAL/PHARMACY/TRICARE: " "RTN","RCDPEM4",302,0) .S Y=Y_$S(RCTYPE="M":"MEDICAL",RCTYPE="P":"PHARMACY",RCTYPE="T":"TRICARE",1:"ALL") "RTN","RCDPEM4",303,0) .S HCNT=HCNT+1,RCHDR(HCNT)=Y "RTN","RCDPEM4",304,0) .S HCNT=HCNT+1,RCHDR(HCNT)="" "RTN","RCDPEM4",305,0) .S Y="Date Range: "_START_" - "_END_" (DATE ERA UPDATED)" "RTN","RCDPEM4",306,0) .S HCNT=HCNT+1,RCHDR(HCNT)=Y "RTN","RCDPEM4",307,0) .S HCNT=HCNT+1,RCHDR(HCNT)="" "RTN","RCDPEM4",308,0) .S HCNT=HCNT+1,RCHDR(HCNT)=" Date/Time User Who EFT Match Status" "RTN","RCDPEM4",309,0) .S HCNT=HCNT+1,RCHDR(HCNT)="ERA # Receipt # ERA Updated Updated Detail Post Status" "RTN","RCDPEM4",310,0) .S RCHDR(0)=HCNT ; header line count "RTN","RCDPEM4",311,0) ; "RTN","RCDPEM4",312,0) I RCRTYP="EOB" D "RTN","RCDPEM4",313,0) .D HDRXEC(RCRTYP) ; xecute code for line 1 "RTN","RCDPEM4",314,0) .S Y="Divisions: "_$S(VAUTD=1:"ALL",1:DVFLTR)_" " "RTN","RCDPEM4",315,0) .; PRCA*4.5*326 "RTN","RCDPEM4",316,0) .S Y=Y_"MEDICAL/PHARMACY/TRICARE: " "RTN","RCDPEM4",317,0) .S Y=Y_$S(RCTYPE="M":"MEDICAL",RCTYPE="P":"PHARMACY",RCTYPE="T":"TRICARE",1:"ALL") "RTN","RCDPEM4",318,0) .S HCNT=1,RCHDR(HCNT)=Y "RTN","RCDPEM4",319,0) .S Y="Date Range: "_START_" - "_END_" (Date EEOB was Moved/Copied/Removed)" "RTN","RCDPEM4",320,0) .S HCNT=2,RCHDR(HCNT)=Y "RTN","RCDPEM4",321,0) .S Y="Action(s) Selected: "_$S(RCACT="M":"MOVE",RCACT="C":"COPY",RCACT="R":"REMOVE",1:"ALL") "RTN","RCDPEM4",322,0) .S HCNT=3,RCHDR(HCNT)=Y "RTN","RCDPEM4",323,0) .S HCNT=4,RCHDR(HCNT)="" "RTN","RCDPEM4",324,0) .S HCNT=5,RCHDR(HCNT)="Orig Bill# Trace #" "RTN","RCDPEM4",325,0) .S HCNT=6,RCHDR(HCNT)=" Moved/Copied/ Total Amt User Who Moved/" "RTN","RCDPEM4",326,0) .S HCNT=7,RCHDR(HCNT)=" ERA # Date/Time Removed Paid Copied/Removed" "RTN","RCDPEM4",327,0) .S RCHDR(0)=HCNT ; header line count "RTN","RCDPEM4",328,0) ; "RTN","RCDPEM4",329,0) ; add row of equal signs, not for ListMan "RTN","RCDPEM4",330,0) S:'RCLSTMGR Y=RCHDR(0)+1,RCHDR(0)=Y,RCHDR(Y)=" "_$TR($J("",78)," ","=") "RTN","RCDPEM4",331,0) Q "RTN","RCDPEM4",332,0) ; "RTN","RCDPEM4",333,0) HDREOB() ; extrinsic variable, header for EOB report "RTN","RCDPEM4",334,0) Q "EEOB Move/Copy/Remove - Audit Report" "RTN","RCDPEM4",335,0) ; "RTN","RCDPEM4",336,0) HDRERA() ; extrinsic variable, header for ERA report "RTN","RCDPEM4",337,0) Q "ERAs Posted with Paper EOB - Audit Report" "RTN","RCDPEM4",338,0) ; "RTN","RCDPEM4",339,0) HDRXEC(TYP) ; create xecute code for header "RTN","RCDPEM4",340,0) S RCHDR("XECUTE")="N Y S RCPGNUM=RCPGNUM+1,Y=$$HDR"_TYP_"^"_$T(+0)_",RCHDR(1)=$J("" "",80-$L(Y)\2)_Y"_"_"" Page: ""_RCPGNUM" "RTN","RCDPEM4",341,0) Q "RTN","RCDPEM4",342,0) ; "RTN","RCDPEM4",343,0) DTRNG() ; function, return date range for a report "RTN","RCDPEM4",344,0) N DIR,DUOUT,X,Y,RCSTART,RCEND "RTN","RCDPEM4",345,0) D DATES(.RCSTART,.RCEND) "RTN","RCDPEM4",346,0) Q:RCSTART=-1 0 "RTN","RCDPEM4",347,0) Q:RCSTART "1^"_RCSTART_"^"_RCEND "RTN","RCDPEM4",348,0) Q:'RCSTART "0^^" "RTN","RCDPEM4",349,0) Q 0 "RTN","RCDPEM4",350,0) ; "RTN","RCDPEM4",351,0) DATES(BDATE,EDATE) ;Get a date range. "RTN","RCDPEM4",352,0) S (BDATE,EDATE)=0 "RTN","RCDPEM4",353,0) S DIR("?")="Enter the latest date of receipt of deposit to include on the report." "RTN","RCDPEM4",354,0) S DIR(0)="DAO^:"_DT_":APE",DIR("A")="Start date: " D ^DIR K DIR "RTN","RCDPEM4",355,0) I $D(DTOUT)!$D(DUOUT)!(Y="") S BDATE=-1 Q "RTN","RCDPEM4",356,0) S BDATE=Y "RTN","RCDPEM4",357,0) S DIR("?")="Enter the latest date of receipt of deposit to include on the report." "RTN","RCDPEM4",358,0) S DIR("B")=Y(0) "RTN","RCDPEM4",359,0) S DIR(0)="DAO^"_BDATE_":"_DT_":APE",DIR("A")=" End date: " D ^DIR K DIR "RTN","RCDPEM4",360,0) I $D(DTOUT)!$D(DUOUT)!(Y="") S BDATE=-1 Q "RTN","RCDPEM4",361,0) S EDATE=Y "RTN","RCDPEM4",362,0) Q "RTN","RCDPEM4",363,0) ; "RTN","RCDPEM4",364,0) STADIV ;Division/Station Filter/Sort "RTN","RCDPEM4",365,0) ; "RTN","RCDPEM4",366,0) ;Sort selection "RTN","RCDPEM4",367,0) N DIR,DUOUT,Y "RTN","RCDPEM4",368,0) S RCDIV=0 "RTN","RCDPEM4",369,0) ; "RTN","RCDPEM4",370,0) ;Division selection - IA 664 "RTN","RCDPEM4",371,0) ;RETURNS Y=-1 (quit), VAUTD=1 (for all),VAUTD=0 (selected divisions in VAUTD) "RTN","RCDPEM4",372,0) D DIVISION^VAUTOMA Q:Y<0 "RTN","RCDPEM4",373,0) ; "RTN","RCDPEM4",374,0) ;If ALL selected "RTN","RCDPEM4",375,0) I VAUTD=1 S RCDIV=1 Q "RTN","RCDPEM4",376,0) ;If some DIVISIONS selected "RTN","RCDPEM4",377,0) S RCDIV=2 "RTN","RCDPEM4",378,0) Q "RTN","RCDPEM4",379,0) ; "RTN","RCDPEM4",380,0) ACTION() ; Get action type "RTN","RCDPEM4",381,0) N DIR,X,Y,DIROUT,DUOUT "RTN","RCDPEM4",382,0) S DIR("A")="Move/Copy/Remove or All (M/C/R/A): " "RTN","RCDPEM4",383,0) S DIR("B")="All" ; default to ALL "RTN","RCDPEM4",384,0) S DIR(0)="SAB^M:Move;C:Copy;R:Remove;A:All" "RTN","RCDPEM4",385,0) D ^DIR Q:$G(DIROUT)!$G(DUOUT) -1 "RTN","RCDPEM4",386,0) ; "RTN","RCDPEM4",387,0) Q Y "RTN","RCDPEM4",388,0) ; "RTN","RCDPEM4",389,0) DISPTY() ; Get display/output type "RTN","RCDPEM4",390,0) N DIR,DTOUT,DUOUT,X,Y "RTN","RCDPEM4",391,0) S DIR(0)="YA" "RTN","RCDPEM4",392,0) S DIR("A")="Export the report to Microsoft Excel? " "RTN","RCDPEM4",393,0) S DIR("B")="NO" "RTN","RCDPEM4",394,0) D ^DIR I $G(DUOUT) Q -1 "RTN","RCDPEM4",395,0) Q Y "RTN","RCDPEM4",396,0) ; "RTN","RCDPEM4",397,0) ERASTA(ERAIEN,STA,STNUM,STNAM) ; Get the station for this ERA "RTN","RCDPEM4",398,0) ; read allowed on BILL/CLAIMS file (#399) via IA 3820 "RTN","RCDPEM4",399,0) ; returns STA: station IEN, STNAM: station name, STNUM: station number "RTN","RCDPEM4",400,0) N ERAEOB,ERABILL,STAIEN "RTN","RCDPEM4",401,0) S (ERAEOB,ERABILL)="" "RTN","RCDPEM4",402,0) S (STA,STNUM,STNAM)="UNKNOWN" "RTN","RCDPEM4",403,0) D "RTN","RCDPEM4",404,0) .S ERAEOB=$P($G(^RCY(344.4,ERAIEN,1,1,0)),U,2) Q:'ERAEOB ; if EOB pointer not on first sub-file entry then stop "RTN","RCDPEM4",405,0) .S ERABILL=$P($G(^IBM(361.1,ERAEOB,0)),U,1) Q:'ERABILL ; EXPLANATION OF BENEFITS file (#361.1) "RTN","RCDPEM4",406,0) .S STAIEN=$P($G(^DGCR(399,ERABILL,0)),U,22) Q:'STAIEN ;(#.22) DEFAULT DIVISION [22P:40.8] "RTN","RCDPEM4",407,0) .S STA=STAIEN "RTN","RCDPEM4",408,0) .S STNAM=$$EXTERNAL^DILFD(399,.22,,STA) "RTN","RCDPEM4",409,0) .S STNUM=$P($G(^DG(40.8,STAIEN,0)),U,2) ;IA 417 "RTN","RCDPEM4",410,0) ; "RTN","RCDPEM4",411,0) Q "RTN","RCDPEM4",412,0) ; "RTN","RCDPEM4",413,0) EOBSTA(EOBIEN,STA,STNUM,STNAM) ; Get the station for this EOB "RTN","RCDPEM4",414,0) ;Allowed read on 399 via IA 3820 "RTN","RCDPEM4",415,0) N BILL,STAIEN "RTN","RCDPEM4",416,0) S (BILL)="" "RTN","RCDPEM4",417,0) S (STA,STNUM,STNAM)="UNKNOWN" "RTN","RCDPEM4",418,0) D "RTN","RCDPEM4",419,0) .S BILL=$P(^IBM(361.1,EOBIEN,0),U,1) Q:'BILL "RTN","RCDPEM4",420,0) .S STAIEN=$P($G(^DGCR(399,BILL,0)),U,22) Q:'STAIEN "RTN","RCDPEM4",421,0) .S STA=STAIEN "RTN","RCDPEM4",422,0) .S STNAM=$$EXTERNAL^DILFD(399,.22,,STA) "RTN","RCDPEM4",423,0) .S STNUM=$P($G(^DG(40.8,STAIEN,0)),U,2) ;IA 417 "RTN","RCDPEM4",424,0) Q "RTN","RCDPEM4",425,0) ; "RTN","RCDPEM4",426,0) DTPRB() ; Get the Start Date type "RTN","RCDPEM4",427,0) N DIR,DTOUT,DUOUT,DIRUT,DIROUT,X,Y "RTN","RCDPEM4",428,0) S DIR(0)="SABO^W:Date Removed from Worklist;R:Date ERA Received;B:Both Dates" "RTN","RCDPEM4",429,0) S DIR("A")="Select Start Date Type: " "RTN","RCDPEM4",430,0) D ^DIR K DIR "RTN","RCDPEM4",431,0) I $D(DTOUT)!$D(DUOUT)!(Y="") S Y=0 "RTN","RCDPEM4",432,0) Q Y "RTN","RCDPEM4",433,0) ; "RTN","RCDPEM4",434,0) WP(JC) ; format justification comments "RTN","RCDPEM4",435,0) ; JC - Justification Comment "RTN","RCDPEM4",436,0) I JC="" Q "RTN","RCDPEM4",437,0) N PCS,I,CNTR,CMNT,Y "RTN","RCDPEM4",438,0) ; PCS - Number of " " $pieces in the comment "RTN","RCDPEM4",439,0) ; CNTR - CMNT line counter "RTN","RCDPEM4",440,0) ; CMNT - comment text to be displayed "RTN","RCDPEM4",441,0) S PCS=$L(JC," "),CNTR=1,CMNT(CNTR)=" Justification Comments: " "RTN","RCDPEM4",442,0) F I=1:1:PCS D "RTN","RCDPEM4",443,0) .S Y=$P(JC," ",I) "RTN","RCDPEM4",444,0) .S:$L(CMNT(CNTR))+$L(Y)>72 CNTR=CNTR+1,CMNT(CNTR)=$J(" ",25) "RTN","RCDPEM4",445,0) .S CMNT(CNTR)=CMNT(CNTR)_" "_Y "RTN","RCDPEM4",446,0) ; "RTN","RCDPEM4",447,0) F I=1:1:CNTR D SL^RCDPEARL(CMNT(I),.RCLNCNT,RCTMPND) "RTN","RCDPEM4",448,0) Q "RTN","RCDPEM4",449,0) ; "RTN","RCDPEM5") 0^34^B169813342 "RTN","RCDPEM5",1,0) RCDPEM5 ;ALB/PJH - EPAYMENTS MOVE EEOB TO NEW CLAIM ;Oct 29, 2014@16:43:51 "RTN","RCDPEM5",2,0) ;;4.5;Accounts Receivable;**173,208,276,298,321,332**;Mar 20, 1995;Build 40 "RTN","RCDPEM5",3,0) ;Per VA Directive 6402, this routine should not be modified. "RTN","RCDPEM5",4,0) Q "RTN","RCDPEM5",5,0) ; "RTN","RCDPEM5",6,0) EN ;Entry point for EEOB Move/Copy/Remove [RCDPE EEOB MOVE/COPY/REMOVE] option "RTN","RCDPEM5",7,0) ; "RTN","RCDPEM5",8,0) N DIR,X,Y,DIROUT,DUOUT,MODE "RTN","RCDPEM5",9,0) S DIR("A")="Select action" "RTN","RCDPEM5",10,0) S DIR("B")="M" "RTN","RCDPEM5",11,0) S DIR(0)="S^M:Move EEOB to different claim;" "RTN","RCDPEM5",12,0) S DIR(0)=DIR(0)_"C:Copy EEOB to multiple claims;" "RTN","RCDPEM5",13,0) S DIR(0)=DIR(0)_"R:Remove EEOB from claim" "RTN","RCDPEM5",14,0) D ^DIR Q:$G(DIROUT)!$G(DUOUT) "RTN","RCDPEM5",15,0) S MODE=Y "RTN","RCDPEM5",16,0) ; "RTN","RCDPEM5",17,0) ; - PRCA*4.5*298 - OWNSKEY^XUSRB - Supported IA 3277 "RTN","RCDPEM5",18,0) I MODE="R" N MSG D OWNSKEY^XUSRB(.MSG,"RCDPE REMOVE EEOB",DUZ) I 'MSG(0) D Q "RTN","RCDPEM5",19,0) .W !!,"SORRY, YOU ARE NOT AUTHORIZED TO USE THIS ACTION" "RTN","RCDPEM5",20,0) .W !,"This action is locked with RCDPE REMOVE EEOB key.",! "RTN","RCDPEM5",21,0) .N DIR S DIR(0)="E" D ^DIR "RTN","RCDPEM5",22,0) ; "RTN","RCDPEM5",23,0) ;Read access to file #361.1 under IA 4051 "RTN","RCDPEM5",24,0) ; "RTN","RCDPEM5",25,0) N DA,DIC,DIE,DIR,DR,NCLAIM,ORIG,ORIGNAM,X,Y "RTN","RCDPEM5",26,0) ; "RTN","RCDPEM5",27,0) ;Allow selection of a original third party EOB "RTN","RCDPEM5",28,0) S DIC("A")="Select EXPLANATION OF BENEFIT (EEOB) to "_$S(MODE="M":"MOVE",MODE="R":"REMOVE",1:"COPY")_": " "RTN","RCDPEM5",29,0) ; screen to only allow selection of an active EEOB (not marked as deleted) and non-MRA type EOB "RTN","RCDPEM5",30,0) S DIC("S")="I ($P(^(0),U,4)=0)&('$P($G(^(102)),U))",DIC="^IBM(361.1,",DIC(0)="AEMQ" "RTN","RCDPEM5",31,0) W ! D ^DIC K DIC "RTN","RCDPEM5",32,0) ; "RTN","RCDPEM5",33,0) I Y'>0 Q "RTN","RCDPEM5",34,0) ; controlled subscription IA 1992 "RTN","RCDPEM5",35,0) S ORIG=+Y,ORIGNAM=$$GET1^DIQ(399,$P(Y,U,2),.01) "RTN","RCDPEM5",36,0) ; "RTN","RCDPEM5",37,0) ;Get current bill payer sequence from claim - IA 3820 "RTN","RCDPEM5",38,0) D "RTN","RCDPEM5",39,0) .N CURR,IEN399 "RTN","RCDPEM5",40,0) .S IEN399=$P($G(^IBM(361.1,ORIG,0)),U) Q:'IEN399 "RTN","RCDPEM5",41,0) .S CURR=$P($G(^DGCR(399,IEN399,0)),U,21) I (CURR'="T")&(CURR'="S") Q "RTN","RCDPEM5",42,0) .W !!,"Warning - selected EEOB has secondary claims and may have tertiary claims" "RTN","RCDPEM5",43,0) ; "RTN","RCDPEM5",44,0) ;Lock Original EOB "RTN","RCDPEM5",45,0) Q:'$$LOCK^IBCEOB4(ORIG) "RTN","RCDPEM5",46,0) ; "RTN","RCDPEM5",47,0) ;Remove Option "RTN","RCDPEM5",48,0) I MODE="R" D REMOVE(ORIG,MODE),EXIT Q "RTN","RCDPEM5",49,0) ; "RTN","RCDPEM5",50,0) ;Select Claim(s) to Move/Copy to "RTN","RCDPEM5",51,0) N RCBILL,RCBILLNM,NCLAIM,NCLAIMX,QUIT,SUB,LIT "RTN","RCDPEM5",52,0) S SUB=0,QUIT=0,LIT="" "RTN","RCDPEM5",53,0) W ! "RTN","RCDPEM5",54,0) F D Q:QUIT Q:SUB&(MODE="M") "RTN","RCDPEM5",55,0) .;Allow selection of a third party claim "RTN","RCDPEM5",56,0) .I MODE="M" S DIC("A")="Select A/R Bill to MOVE to: " "RTN","RCDPEM5",57,0) .I MODE="C" S DIC("A")="Select "_LIT_"A/R Bill to COPY to: " "RTN","RCDPEM5",58,0) .S DIC="^PRCA(430,",DIC(0)="AEMQ",DIC("S")="I $D(^DGCR(399,+Y,0))&($$VALSTAT^RCDPEM5(+Y))" "RTN","RCDPEM5",59,0) .D ^DIC K DIC "RTN","RCDPEM5",60,0) .I Y'>0 S QUIT=1 Q "RTN","RCDPEM5",61,0) .S RCBILL=+Y,RCBILLNM=$P($P(Y,U,2),"-",2) "RTN","RCDPEM5",62,0) .I ORIGNAM=RCBILLNM,MODE="M" W !,"Cannot move EEOB to same claim" Q "RTN","RCDPEM5",63,0) .I $D(NCLAIMX(RCBILL)) W !,"Claim already entered" Q "RTN","RCDPEM5",64,0) .S SUB=SUB+1,NCLAIM(SUB)=RCBILL,NCLAIMX(RCBILL)="" "RTN","RCDPEM5",65,0) .S:MODE="C" LIT="another " "RTN","RCDPEM5",66,0) ; "RTN","RCDPEM5",67,0) I $G(DUOUT)!$G(DIROUT) D EXIT Q "RTN","RCDPEM5",68,0) ; "RTN","RCDPEM5",69,0) ;User Exit or no claims selected "RTN","RCDPEM5",70,0) I '$O(NCLAIM("")) D EXIT Q "RTN","RCDPEM5",71,0) ; "RTN","RCDPEM5",72,0) ;Prompt user to continue "RTN","RCDPEM5",73,0) N DIR,X,Y,DIROUT "RTN","RCDPEM5",74,0) S DIR(0)="Y",DIR("B")="YES" "RTN","RCDPEM5",75,0) S DIR("A")=$$PROMPT(ORIG,.NCLAIM,MODE) "RTN","RCDPEM5",76,0) W ! D ^DIR "RTN","RCDPEM5",77,0) ; "RTN","RCDPEM5",78,0) I $G(DIROUT)!$G(DUOUT)!(Y=0) D EXIT Q "RTN","RCDPEM5",79,0) ; "RTN","RCDPEM5",80,0) ;Enter Justification Comment "RTN","RCDPEM5",81,0) N DIR,DIROUT,DUOUT,JCOM,X,Y "RTN","RCDPEM5",82,0) S DIR(0)="FA^1:100^K:$TR(X,"" "","""")="""" X",DIR("A")="Enter JUSTIFICATION COMMENT: " "RTN","RCDPEM5",83,0) W ! D ^DIR I $G(DIROUT)!$G(DUOUT) W !!,"Update not performed" D EXIT Q "RTN","RCDPEM5",84,0) S JCOM=Y "RTN","RCDPEM5",85,0) ; "RTN","RCDPEM5",86,0) ;Update EOB "RTN","RCDPEM5",87,0) D UPDATE(ORIG,.NCLAIM,MODE,JCOM),EXIT "RTN","RCDPEM5",88,0) ; "RTN","RCDPEM5",89,0) Q "RTN","RCDPEM5",90,0) ; "RTN","RCDPEM5",91,0) ;Unlock original EOB "RTN","RCDPEM5",92,0) EXIT D UNLOCK^IBCEOB4(ORIG) "RTN","RCDPEM5",93,0) Q "RTN","RCDPEM5",94,0) ; "RTN","RCDPEM5",95,0) ;File EOB #361.1 changes - Integration Agreement 5671 for IBCEOB4 "RTN","RCDPEM5",96,0) UPDATE(ORIG,NCLAIM,MODE,JUST) ; "RTN","RCDPEM5",97,0) ; Input - ORIG - Original EOB "RTN","RCDPEM5",98,0) ; - NCLAIM - New claim (s) "RTN","RCDPEM5",99,0) ; - MODE M=Move C=Copy "RTN","RCDPEM5",100,0) ; - JUST = User input justification text "RTN","RCDPEM5",101,0) ; Output - Updates EOB and Audit log "RTN","RCDPEM5",102,0) N JUST1 "RTN","RCDPEM5",103,0) ;Move EOB "RTN","RCDPEM5",104,0) I MODE="M" D "RTN","RCDPEM5",105,0) .;Auto generate text for AR comments on original claim "RTN","RCDPEM5",106,0) .S JUST1=$$JUST1(ORIG,.NCLAIM,"M",0) "RTN","RCDPEM5",107,0) .;Update AR Comments on the 'from bill' "RTN","RCDPEM5",108,0) .D AUDIT^RCDPAYER(ORIG,JUST_"^"_JUST1,MODE) "RTN","RCDPEM5",109,0) .;Change claim number on EEOB "RTN","RCDPEM5",110,0) .D MOVE^IBCEOB4(ORIG,NCLAIM(1),DUZ,$$NOW^XLFDT,JUST,MODE) "RTN","RCDPEM5",111,0) .;Update AR Comments on 'to bill' "RTN","RCDPEM5",112,0) .D AUDIT^RCDPAYER(ORIG,JUST_"^"_JUST1,MODE) "RTN","RCDPEM5",113,0) ;Copy EOB "RTN","RCDPEM5",114,0) I MODE="C" D "RTN","RCDPEM5",115,0) .D COPY^IBCEOB4(ORIG,.NCLAIM,DUZ,$$NOW^XLFDT,JUST,MODE) "RTN","RCDPEM5",116,0) .;Auto generate text for AR comments on original claim "RTN","RCDPEM5",117,0) .S JUST1=$$JUST1(ORIG,.NCLAIM,"C",0) "RTN","RCDPEM5",118,0) .;Update AR Comments on original claim "RTN","RCDPEM5",119,0) .D AUDIT^RCDPAYER(ORIG,JUST_"^"_JUST1,MODE) "RTN","RCDPEM5",120,0) .;Auto generate text for AR comments on new claim "RTN","RCDPEM5",121,0) .S JUST1=$$JUST1(ORIG,.NCLAIM,"C",1) "RTN","RCDPEM5",122,0) .;Update AR Comments on new claims "RTN","RCDPEM5",123,0) .N SUB,NEWEOB "RTN","RCDPEM5",124,0) .S SUB=0 "RTN","RCDPEM5",125,0) .F S SUB=$O(NCLAIM(SUB)) Q:'SUB D "RTN","RCDPEM5",126,0) ..;Convert Claim pointer to EOB pointer "RTN","RCDPEM5",127,0) ..S NEWEOB=$O(^IBM(361.1,"B",NCLAIM(SUB),0)) Q:'NEWEOB "RTN","RCDPEM5",128,0) ..D AUDIT^RCDPAYER(NEWEOB,JUST_"^"_JUST1,MODE) "RTN","RCDPEM5",129,0) W !!,"EEOB Update Complete" H 1 "RTN","RCDPEM5",130,0) Q "RTN","RCDPEM5",131,0) ; "RTN","RCDPEM5",132,0) PROMPT(ORIG,NCLAIM,MODE) ;Construct prompt text "RTN","RCDPEM5",133,0) ; Input - ORIG - Original EOB "RTN","RCDPEM5",134,0) ; - NCLAIM - New claim (s) "RTN","RCDPEM5",135,0) ; - MODE M=Move C=Copy "RTN","RCDPEM5",136,0) ; Output - Justification text "RTN","RCDPEM5",137,0) ; "RTN","RCDPEM5",138,0) N FIRST,STR,STR1,SUB,TEXT "RTN","RCDPEM5",139,0) ;Move or copy text "RTN","RCDPEM5",140,0) S TEXT=$$EXTERNAL^DILFD(361.1,.01,,$P($G(^IBM(361.1,ORIG,0)),U)) "RTN","RCDPEM5",141,0) I MODE="M" S STR="Move EEOB from claim "_TEXT_" to claim " "RTN","RCDPEM5",142,0) E S STR="Copy EEOB from claim "_TEXT_" to claim(s) " "RTN","RCDPEM5",143,0) ;Build list of claims "RTN","RCDPEM5",144,0) S STR1="",SUB="",FIRST=1 "RTN","RCDPEM5",145,0) F S SUB=$O(NCLAIM(SUB)) Q:'SUB D "RTN","RCDPEM5",146,0) .S TEXT=$P($G(^PRCA(430,NCLAIM(SUB),0)),U) "RTN","RCDPEM5",147,0) .I FIRST S STR1=STR1_$P(TEXT,"-",2),FIRST=0 Q "RTN","RCDPEM5",148,0) .S STR1=STR1_", "_$P(TEXT,"-",2) "RTN","RCDPEM5",149,0) ;Return full prompt text "RTN","RCDPEM5",150,0) Q STR_STR1_" " "RTN","RCDPEM5",151,0) ; "RTN","RCDPEM5",152,0) JUST(ORIG,NCLAIM,MODE,TYPE,SRC) ;Construct justification text for automatic updates "RTN","RCDPEM5",153,0) ; Input - ORIG - Original EOB "RTN","RCDPEM5",154,0) ; - NCLAIM - New claim (s) "RTN","RCDPEM5",155,0) ; - MODE - "M" = Move "C" =Copy "R" = Remove "RTN","RCDPEM5",156,0) ; - TYPE - 0 = old EOB 1 = new EOB "RTN","RCDPEM5",157,0) ; - SRC - "W" = Worklist "A" = Auto-post, "L" = Link Payment "RTN","RCDPEM5",158,0) ; Output - Justification text "RTN","RCDPEM5",159,0) N FIRST,STR,STR1,SUB,TEXT "RTN","RCDPEM5",160,0) ;Original bill number "RTN","RCDPEM5",161,0) S TEXT=$$EXTERNAL^DILFD(361.1,.01,,$P($G(^IBM(361.1,ORIG,0)),U)) "RTN","RCDPEM5",162,0) ;Justification comment for original EOB "RTN","RCDPEM5",163,0) I TYPE=0 D "RTN","RCDPEM5",164,0) .I MODE="R" S STR="EEOB removed from claim "_TEXT,STR1="" Q ;PRCA*4.5*321 "RTN","RCDPEM5",165,0) .I MODE="M" S STR="EEOB from claim "_TEXT_" moved to claim " "RTN","RCDPEM5",166,0) .I MODE="C" S STR="EEOB from claim "_TEXT_" copied to claim(s) " "RTN","RCDPEM5",167,0) .;Build list of claims "RTN","RCDPEM5",168,0) .S STR1="",SUB="",FIRST=1 "RTN","RCDPEM5",169,0) .F S SUB=$O(NCLAIM(SUB)) Q:'SUB D "RTN","RCDPEM5",170,0) ..S TEXT=$P($G(^PRCA(430,NCLAIM(SUB),0)),U) "RTN","RCDPEM5",171,0) ..I FIRST S STR1=STR1_$P(TEXT,"-",2),FIRST=0 Q "RTN","RCDPEM5",172,0) ..S STR1=STR1_", "_$P(TEXT,"-",2) "RTN","RCDPEM5",173,0) ;Justification comment for new EOB's "RTN","RCDPEM5",174,0) I TYPE=1 D "RTN","RCDPEM5",175,0) .I MODE="M" S STR="EEOB moved from EEOB for claim "_TEXT,STR1="" "RTN","RCDPEM5",176,0) .I MODE="C" S STR="EEOB copied from EEOB for claim "_TEXT,STR1="" "RTN","RCDPEM5",177,0) ;Return full justification text "RTN","RCDPEM5",178,0) Q STR_STR1_" automatically by "_$S(SRC="A":"Auto-post",SRC="L":"Link Payment",1:"Worklist") "RTN","RCDPEM5",179,0) ; "RTN","RCDPEM5",180,0) JUST1(ORIG,NCLAIM,MODE,TYPE) ;Construct AR comment for stand-alone MCR option "RTN","RCDPEM5",181,0) ; Input - ORIG - Original EOB "RTN","RCDPEM5",182,0) ; - NCLAIM - New claim (s) "RTN","RCDPEM5",183,0) ; - MODE M=Move C=Copy "RTN","RCDPEM5",184,0) ; - TYPE = 0 - original EOB 1 - new EOB(s) "RTN","RCDPEM5",185,0) ; Output - Justification text "RTN","RCDPEM5",186,0) N FIRST,STR,STR1,SUB,TEXT "RTN","RCDPEM5",187,0) ;Original bill number "RTN","RCDPEM5",188,0) S TEXT=$$EXTERNAL^DILFD(361.1,.01,,$P($G(^IBM(361.1,ORIG,0)),U)) "RTN","RCDPEM5",189,0) ;Justification comment for original EOB "RTN","RCDPEM5",190,0) I TYPE=0 D "RTN","RCDPEM5",191,0) .I MODE="M" S STR="EEOB from claim "_TEXT_" moved to claim " "RTN","RCDPEM5",192,0) .I MODE="C" S STR="EEOB from claim "_TEXT_" copied to claim(s) " "RTN","RCDPEM5",193,0) .;Build list of claims "RTN","RCDPEM5",194,0) .S STR1="",SUB="",FIRST=1 "RTN","RCDPEM5",195,0) .F S SUB=$O(NCLAIM(SUB)) Q:'SUB D "RTN","RCDPEM5",196,0) ..S TEXT=$P($G(^PRCA(430,NCLAIM(SUB),0)),U) "RTN","RCDPEM5",197,0) ..I FIRST S STR1=STR1_$P(TEXT,"-",2),FIRST=0 Q "RTN","RCDPEM5",198,0) ..S STR1=STR1_", "_$P(TEXT,"-",2) "RTN","RCDPEM5",199,0) ;Justification comment for new EOB's "RTN","RCDPEM5",200,0) I TYPE=1 D "RTN","RCDPEM5",201,0) .I MODE="M" S STR="EEOB moved from EEOB for claim "_TEXT,STR1="" "RTN","RCDPEM5",202,0) .I MODE="C" S STR="EEOB copied from EEOB for claim "_TEXT,STR1="" "RTN","RCDPEM5",203,0) ;Return comment text "RTN","RCDPEM5",204,0) Q STR_STR1 "RTN","RCDPEM5",205,0) ; "RTN","RCDPEM5",206,0) FINDEOB(IEN3444,BILL) ;Find EOB for a claim within an ERA "RTN","RCDPEM5",207,0) ; Input - IEN3444 = ERA ien "RTN","RCDPEM5",208,0) ; BILL = Bill number "RTN","RCDPEM5",209,0) ; Output - IEN of EOB in #361.1 "RTN","RCDPEM5",210,0) N IEN3611,SUB "RTN","RCDPEM5",211,0) S (SUB,IEN3611)=0 "RTN","RCDPEM5",212,0) F S SUB=$O(^RCY(344.4,IEN3444,1,"AC",SUB)) Q:'SUB D Q:IEN3611 "RTN","RCDPEM5",213,0) .I $$EXTERNAL^DILFD(344.41,.02,,SUB)=BILL S IEN3611=SUB "RTN","RCDPEM5",214,0) Q IEN3611 "RTN","RCDPEM5",215,0) ; "RTN","RCDPEM5",216,0) REMOVE(ORIG,MODE) ; Interactive option to Remove EEOB - PRCA*4.5*298 "RTN","RCDPEM5",217,0) ; Input - ORIG = original EOB in #361.1 "RTN","RCDPEM5",218,0) ; Output - mode = "R" "RTN","RCDPEM5",219,0) ; "RTN","RCDPEM5",220,0) ;Prompt user to continue "RTN","RCDPEM5",221,0) N DIR,X,Y,DIROUT "RTN","RCDPEM5",222,0) S DIR(0)="Y",DIR("B")="YES" "RTN","RCDPEM5",223,0) S DIR("A")="Are you sure you want to remove EEOB from claim "_ORIGNAM_" (Y/N)?" "RTN","RCDPEM5",224,0) W ! D ^DIR "RTN","RCDPEM5",225,0) ; "RTN","RCDPEM5",226,0) I $G(DIROUT)!$G(DUOUT)!(Y=0) Q "RTN","RCDPEM5",227,0) ; "RTN","RCDPEM5",228,0) ;Enter Justification Comment "RTN","RCDPEM5",229,0) N DIR,DIROUT,DUOUT,JUST,X,Y "RTN","RCDPEM5",230,0) S DIR(0)="FA^1:100^K:$TR(X,"" "","""")="""" X",DIR("A")="Enter JUSTIFICATION COMMENT: " "RTN","RCDPEM5",231,0) W ! D ^DIR I $G(DIROUT)!$G(DUOUT) W !!,"Update not performed" D EXIT Q "RTN","RCDPEM5",232,0) S JUST=Y "RTN","RCDPEM5",233,0) ; "RTN","RCDPEM5",234,0) ;Update EEOB "RTN","RCDPEM5",235,0) D REMOVE^IBCEOB4(ORIG,DUZ,JUST) "RTN","RCDPEM5",236,0) ;Update AR Comments for removed claim "RTN","RCDPEM5",237,0) D AUDIT^RCDPAYER(ORIG,JUST,MODE) "RTN","RCDPEM5",238,0) ; "RTN","RCDPEM5",239,0) W !!,"EEOB Update Complete" H 1 "RTN","RCDPEM5",240,0) Q "RTN","RCDPEM5",241,0) ; "RTN","RCDPEM5",242,0) VALSTAT(CLIEN) ; validation on current status of the AR claim selected for the move/copy event "RTN","RCDPEM5",243,0) ; Claims that are in a incomplete state cannot be selected "RTN","RCDPEM5",244,0) ; incomplete states are determined at CURRENT STATUS (8,430) of the AR claim "RTN","RCDPEM5",245,0) ; AR claims with 'BILL INCOMPLETE', 'INCOMPLETE', 'NEW BILL' statuses cannot be selected "RTN","RCDPEM5",246,0) ; CLIEN=430 ien "RTN","RCDPEM5",247,0) ; returns 0 or 1 "RTN","RCDPEM5",248,0) N CSTAT,FLAG "RTN","RCDPEM5",249,0) S CSTAT=$$GET1^DIQ(430,CLIEN,8) "RTN","RCDPEM5",250,0) S FLAG=$S(CSTAT="BILL INCOMPLETE":0,CSTAT="INCOMPLETE":0,CSTAT="NEW BILL":0,1:1) "RTN","RCDPEM5",251,0) Q FLAG "RTN","RCDPEM5",252,0) ; "RTN","RCDPEM5",253,0) ; BEGIN - PRCA*4.5*321 "RTN","RCDPEM5",254,0) AUTO(OBILL,RCSPLIT,RCERA,SRC,ORIG) ;EP from RCDPEM and RCDPEMA "RTN","RCDPEM5",255,0) ; Automatic move copy of EOB "RTN","RCDPEM5",256,0) ; Input: OBILL - Original Bill number in #399 "RTN","RCDPEM5",257,0) ; RCSPLIT - Array of split lines "RTN","RCDPEM5",258,0) ; RCERA - ERA ien #344.4 "RTN","RCDPEM5",259,0) ; SRC - "W" = Worklist "A" = APAR/Autopost "RTN","RCDPEM5",260,0) ; ORIG - IEN of EOB in file #361.1 "RTN","RCDPEM5",261,0) ; Output - Update EOBs and audit trail "RTN","RCDPEM5",262,0) N CCLAIM,FLAG,IFN,J,NCLAIM,NBILL,JUST,JUST1,SUB,SUB1,VALID ; PRCA*4.5*332 "RTN","RCDPEM5",263,0) ; EOB for the original claim must be present "RTN","RCDPEM5",264,0) I 'ORIG Q 1 "RTN","RCDPEM5",265,0) S (SUB,SUB1)=0,VALID=1 ; ; PRCA*4.5*332 "RTN","RCDPEM5",266,0) F J="O","N","S" S FLAG(J)=0 ; PRCA*4.5*332 Initialize flags for original, new and suspense EEOBs "RTN","RCDPEM5",267,0) ; Loop through split lines "RTN","RCDPEM5",268,0) F S SUB=$O(RCSPLIT(SUB)) Q:'SUB D "RTN","RCDPEM5",269,0) . ; Bill Number on split line "RTN","RCDPEM5",270,0) . S NBILL=$P(RCSPLIT(SUB),U,2) "RTN","RCDPEM5",271,0) . S IFN=$P(RCSPLIT(SUB),U,7) ; PRCA*4.5*332 "RTN","RCDPEM5",272,0) . ; Ignore split lines with zero value "RTN","RCDPEM5",273,0) . Q:+$P(RCSPLIT(SUB),U,3)=0 "RTN","RCDPEM5",274,0) . ; Suspense claims, piece 7 is pointer to AR claim file 430 "RTN","RCDPEM5",275,0) . I 'IFN S FLAG("S")=1 Q ; PRCA*4.5*332 "RTN","RCDPEM5",276,0) . ; Is original bill is in the array? "RTN","RCDPEM5",277,0) . I OBILL=NBILL S FLAG("O")=1 ; PRCA*4.5*332 "RTN","RCDPEM5",278,0) . ; Save POINTER to AR Claim file 430 (DINUM to 399) "RTN","RCDPEM5",279,0) . S SUB1=SUB1+1,NCLAIM(SUB1)=IFN "RTN","RCDPEM5",280,0) . ; Build list of new claims to copy "RTN","RCDPEM5",281,0) . I OBILL'=NBILL D ; PRCA*4.5*332 "RTN","RCDPEM5",282,0) . . S CCLAIM(IFN)=IFN ; PRCA*4.5*332 "RTN","RCDPEM5",283,0) . . S FLAG("N")=1 ; PRCA*4.5*332 "RTN","RCDPEM5",284,0) ; "RTN","RCDPEM5",285,0) ; No new claims. Payment must have been split to suspense, or suspense and original payment - no action "RTN","RCDPEM5",286,0) I 'FLAG("N") Q 1 ; PRCA*4.5*332 "RTN","RCDPEM5",287,0) ; "RTN","RCDPEM5",288,0) ; Lock Original EOB "RTN","RCDPEM5",289,0) I '$$LOCK(ORIG) Q 0 "RTN","RCDPEM5",290,0) ; "RTN","RCDPEM5",291,0) ; PRCA*4.5*332 - Start modified code block "RTN","RCDPEM5",292,0) ; If split to single new claim move EOB - i.e. change claim number on EOB "RTN","RCDPEM5",293,0) I SUB1=1,'FLAG("S") D ; "RTN","RCDPEM5",294,0) . ; Change claim number on original EOB attached to ERA "RTN","RCDPEM5",295,0) . D AUTOMOVE(ORIG,.NCLAIM,SRC) ; PRCA*4.5*332 "RTN","RCDPEM5",296,0) ; "RTN","RCDPEM5",297,0) ; Split was to multiple new claims or new claim(s) and suspense - copy original EOB to new claim(s) "RTN","RCDPEM5",298,0) E D ; "RTN","RCDPEM5",299,0) . ; Copy EOB to new EOBs for "to" claims "RTN","RCDPEM5",300,0) . D AUTOCOPY(ORIG,.CCLAIM,SRC) ; PRCA*4.5*332 "RTN","RCDPEM5",301,0) . ; If no money went to suspense or the original EOB "RTN","RCDPEM5",302,0) . ; mark original EOB removed but with text of 'copied to claims....' "RTN","RCDPEM5",303,0) . I 'FLAG("O"),'FLAG("S") D ; "RTN","RCDPEM5",304,0) . . S JUST=$$JUST(ORIG,.CCLAIM,"C",0,SRC)_" then removed" "RTN","RCDPEM5",305,0) . . D AUTOREM(ORIG,JUST) "RTN","RCDPEM5",306,0) ; PRCA*4.5*332 - End modified code block "RTN","RCDPEM5",307,0) ; "RTN","RCDPEM5",308,0) D UNLOCK(ORIG) "RTN","RCDPEM5",309,0) Q 1 "RTN","RCDPEM5",310,0) ; "RTN","RCDPEM5",311,0) AUTOREM(ORIG,JUST) ;Silent remove of EEOB where entire payment is suspensed or moved to other claims "RTN","RCDPEM5",312,0) ; Input - ORIG = EOB in #361.1 "RTN","RCDPEM5",313,0) ; JUST = Justification text "RTN","RCDPEM5",314,0) ; Output - Update EOB in #361.1 and audit trail "RTN","RCDPEM5",315,0) ; "RTN","RCDPEM5",316,0) ;Lock Original EOB "RTN","RCDPEM5",317,0) I '$$LOCK(ORIG) Q "RTN","RCDPEM5",318,0) ;Update EEOB "RTN","RCDPEM5",319,0) D REMOVE^IBCEOB4(ORIG,DUZ,JUST) "RTN","RCDPEM5",320,0) ;Update AR Comments for removed claim "RTN","RCDPEM5",321,0) D AUDIT^RCDPAYER(ORIG,JUST,"R") "RTN","RCDPEM5",322,0) ;Unlock original EOB "RTN","RCDPEM5",323,0) D UNLOCK(ORIG) "RTN","RCDPEM5",324,0) ; "RTN","RCDPEM5",325,0) Q "RTN","RCDPEM5",326,0) ; "RTN","RCDPEM5",327,0) AUTOCOPY(ORIG,CCLAIM,SRC) ; EP from RCDPEU2 - Copy EOBs and upate AR TRANSACTION file - PRCA*4.5*332 "RTN","RCDPEM5",328,0) ; Input: ORIG - IEN for file 361.1 of original EOB "RTN","RCDPEM5",329,0) ; CCLAIM - Array of claims to copy to "RTN","RCDPEM5",330,0) ; SRC - "W" = Worklist "A" = APAR/Autopost "L" = Link Payments "RTN","RCDPEM5",331,0) N JUST,JUST1,MODE,SUB,NEWEOB "RTN","RCDPEM5",332,0) S MODE=$S(SRC="L":"L",1:"W") "RTN","RCDPEM5",333,0) S JUST=$$JUST(ORIG,.CCLAIM,"C",0,SRC) ; Text for original EEOB (copied to claims x,y,z - then removed) "RTN","RCDPEM5",334,0) S JUST1=$$JUST(ORIG,.CCLAIM,"C",1,SRC) ; Text for copied to EEOB (copied from claim w) "RTN","RCDPEM5",335,0) ; Copy EOB to new EOBs for "to" claims "RTN","RCDPEM5",336,0) D COPY^IBCEOB4(ORIG,.CCLAIM,DUZ,$$NOW^XLFDT,JUST1,"C") "RTN","RCDPEM5",337,0) ; "RTN","RCDPEM5",338,0) ; Auto generate text for AR comments on original claim "RTN","RCDPEM5",339,0) D AUDIT^RCDPAYER(ORIG,JUST,MODE) "RTN","RCDPEM5",340,0) ; Auto generate text for AR comments on new claim "RTN","RCDPEM5",341,0) S SUB=0 "RTN","RCDPEM5",342,0) F S SUB=$O(CCLAIM(SUB)) Q:'SUB D "RTN","RCDPEM5",343,0) . ; Convert Claim pointer to EOB pointer "RTN","RCDPEM5",344,0) . S NEWEOB=$O(^IBM(361.1,"B",CCLAIM(SUB),""),-1) Q:'NEWEOB "RTN","RCDPEM5",345,0) . D AUDIT^RCDPAYER(NEWEOB,JUST1,MODE) "RTN","RCDPEM5",346,0) Q "RTN","RCDPEM5",347,0) ; "RTN","RCDPEM5",348,0) AUTOMOVE(ORIG,NCLAIM,SRC) ; EP from RCDPEU2 - Move EOB from one claim to another PRCA*4.5*332 "RTN","RCDPEM5",349,0) ; Input: ORIG - IEN for file 361.1 of original EOB "RTN","RCDPEM5",350,0) ; NCLAIM - Array of new claims "RTN","RCDPEM5",351,0) ; SRC - "W" = Worklist "A" = APAR/Autopost "L" = Link Payments "RTN","RCDPEM5",352,0) N JUST,JUST1,MODE,SUB "RTN","RCDPEM5",353,0) S MODE=$S(SRC="L":"L",1:"W") "RTN","RCDPEM5",354,0) S JUST=$$JUST(ORIG,.NCLAIM,"M",0,SRC) ;Just. Text for original claim "RTN","RCDPEM5",355,0) S JUST1=$$JUST(ORIG,.NCLAIM,"M",1,SRC) ;Just. Text for new claim "RTN","RCDPEM5",356,0) ; Update AR Transaction for original claim "RTN","RCDPEM5",357,0) D AUDIT^RCDPAYER(ORIG,JUST,MODE) "RTN","RCDPEM5",358,0) ; Change claim number on original EOB attached to ERA "RTN","RCDPEM5",359,0) D MOVE^IBCEOB4(ORIG,NCLAIM(1),DUZ,$$NOW^XLFDT,JUST,"M") "RTN","RCDPEM5",360,0) ; Update AR Transaction for new claim "RTN","RCDPEM5",361,0) D AUDIT^RCDPAYER(ORIG,JUST1,MODE) "RTN","RCDPEM5",362,0) Q "RTN","RCDPEM5",363,0) ; "RTN","RCDPEM5",364,0) ;Read access to file #361.1 under IA 4051 "RTN","RCDPEM5",365,0) LOCK(EOBIEN) ;Lock Original EOB "RTN","RCDPEM5",366,0) L +^IBM(361.1,EOBIEN):5 I Q 1 "RTN","RCDPEM5",367,0) Q 0 "RTN","RCDPEM5",368,0) ; "RTN","RCDPEM5",369,0) UNLOCK(EOBIEN) ;Release EOB "RTN","RCDPEM5",370,0) L -^IBM(361.1,EOBIEN) "RTN","RCDPEM5",371,0) Q "RTN","RCDPEM5",372,0) ; END PRCA*4.5*321 "RTN","RCDPEM5",373,0) ; "RTN","RCDPEM5",374,0) ;US1394 ADDITIONS - EP RCDPRPL1 and RCDPLPL3 "RTN","RCDPEM5",375,0) EEOB(RCRCPT,RCTRANDA) ; Option to restore associated suspended/removed EEOB "RTN","RCDPEM5",376,0) ; "RTN","RCDPEM5",377,0) ; INPUT - RCRCPT - Receipt ien #344 "RTN","RCDPEM5",378,0) ; - RCTRANDA - Receipt line #344.01 "RTN","RCDPEM5",379,0) ; "RTN","RCDPEM5",380,0) ; OUTPUT - RCEEOB - selected EEOB ien #361.1 "RTN","RCDPEM5",381,0) ; or 0 if no EEOB "RTN","RCDPEM5",382,0) ; or -1 if ^ abort "RTN","RCDPEM5",383,0) ; "RTN","RCDPEM5",384,0) N CLAIM,DIROUT,DTOUT,DUOUT,RCEEOB,RCEEOBH,RCERA,RCLINE "RTN","RCDPEM5",385,0) ; Get new claim IEN from receipt line "RTN","RCDPEM5",386,0) S CLAIM=$$GET1^DIQ(344.01,RCTRANDA_","_RCRCPT_",",.09,"I") "RTN","RCDPEM5",387,0) ; Quit if this is not a third party claim payment "RTN","RCDPEM5",388,0) Q:CLAIM'["PRCA" 0 "RTN","RCDPEM5",389,0) ; Check if ERA has a suspended EEOB for this line "RTN","RCDPEM5",390,0) S RCEEOB=$$SUSP(RCRCPT,RCTRANDA,.RCERA,.RCLINE) "RTN","RCDPEM5",391,0) ; If no suspended EEOB skip prompt "RTN","RCDPEM5",392,0) Q:'RCEEOB 0 "RTN","RCDPEM5",393,0) ; "RTN","RCDPEM5",394,0) ; Get last move/copy history record - Read access to file #361.1 under IA 4051 "RTN","RCDPEM5",395,0) S RCEEOBH=$O(^IBM(361.1,RCEEOB,101,"A"),-1) "RTN","RCDPEM5",396,0) ; Quit if EEOB if no history found - should not occur since EEOB is suspended "RTN","RCDPEM5",397,0) Q:'RCEEOBH 0 "RTN","RCDPEM5",398,0) ; Display EOB detail "RTN","RCDPEM5",399,0) W !!,"This claim has an associated EEOB on ERA "_RCERA "RTN","RCDPEM5",400,0) W !!,"Claim Number : ",$$GET1^DIQ(344.41,RCLINE_","_RCERA,.02,"E") "RTN","RCDPEM5",401,0) W !,"Trace Number : ",$$GET1^DIQ(344.4,RCERA,.02,"E") "RTN","RCDPEM5",402,0) W !,"Total Amount Paid: ",$$GET1^DIQ(361.1,RCEEOB,1.01,"E") "RTN","RCDPEM5",403,0) W !,"Date/Time Removed: ",$$GET1^DIQ(361.1101,RCEEOBH_","_RCEEOB,.01,"E") "RTN","RCDPEM5",404,0) W !,"Removed by : ",$$GET1^DIQ(361.1101,RCEEOBH_","_RCEEOB,.02,"E") "RTN","RCDPEM5",405,0) W !,"Justification : ",$$GET1^DIQ(361.1101,RCEEOBH_","_RCEEOB,.03,"E"),! "RTN","RCDPEM5",406,0) ; "RTN","RCDPEM5",407,0) ; Confirm that this is the correct EEOB "RTN","RCDPEM5",408,0) K DIR "RTN","RCDPEM5",409,0) S DIR(0)="YO",DIR("B")="NO" "RTN","RCDPEM5",410,0) S DIR("A")="Is this the correct EEOB to associate with this claim" "RTN","RCDPEM5",411,0) D ^DIR "RTN","RCDPEM5",412,0) I $G(DTOUT)!($G(DUOUT)) Q -1 "RTN","RCDPEM5",413,0) Q:Y'=1 0 "RTN","RCDPEM5",414,0) ; "RTN","RCDPEM5",415,0) ;Return selected EEOB "RTN","RCDPEM5",416,0) Q RCEEOB "RTN","RCDPEM5",417,0) ; "RTN","RCDPEM5",418,0) SUSP(RCRCPT,RCTRANDA,RCERA,RCLINE) ; Identify suspended EEOB "RTN","RCDPEM5",419,0) ; "RTN","RCDPEM5",420,0) ; INPUT - RCRCPT - Receipt ien #344 "RTN","RCDPEM5",421,0) ; - RCTRANDA - Receipt line #344.01 "RTN","RCDPEM5",422,0) ; "RTN","RCDPEM5",423,0) ; OUTPUT - RCEEOB - selected EEOB ien #361.1 "RTN","RCDPEM5",424,0) ; - RCERA - ERA ien #344.4 "RTN","RCDPEM5",425,0) ; - RCLINE - ERA line #344.41; "RTN","RCDPEM5",426,0) ; "RTN","RCDPEM5",427,0) N RCEEOB,RCORIG,RCRCZ,RCSPLIT "RTN","RCDPEM5",428,0) ; Get ERA from receipt "RTN","RCDPEM5",429,0) S RCERA=$$GET1^DIQ(344,RCRCPT_",",.18,"I") "RTN","RCDPEM5",430,0) ; Quit if no ERA "RTN","RCDPEM5",431,0) Q:'RCERA 0 "RTN","RCDPEM5",432,0) ; Get ERA Scratchpad line "RTN","RCDPEM5",433,0) S RCRCZ=$$GET1^DIQ(344.01,RCTRANDA_","_RCRCPT_",",.27,"I") "RTN","RCDPEM5",434,0) ; Quit if ERA scratchpad line missing "RTN","RCDPEM5",435,0) Q:'RCRCZ 0 "RTN","RCDPEM5",436,0) ; Get the original line sequence number from before the split was performed "RTN","RCDPEM5",437,0) S RCSPLIT=$$GET1^DIQ(344.491,RCRCZ_","_RCERA_",",.01),RCORIG=RCSPLIT\1 "RTN","RCDPEM5",438,0) ; Convert sequence number into original line IEN "RTN","RCDPEM5",439,0) S RCORIG=$O(^RCY(344.49,RCERA,1,"ASEQ",RCORIG,"")) "RTN","RCDPEM5",440,0) ; Quit if original scratchpad line not found "RTN","RCDPEM5",441,0) Q:'RCORIG 0 "RTN","RCDPEM5",442,0) ; Get ERA line from original scratchpad line "RTN","RCDPEM5",443,0) S RCLINE=$$GET1^DIQ(344.491,RCORIG_","_RCERA_",",.09,"I") "RTN","RCDPEM5",444,0) ; Quit if ERA line not found "RTN","RCDPEM5",445,0) Q:'RCLINE 0 "RTN","RCDPEM5",446,0) ; Get EEOB from ERA line "RTN","RCDPEM5",447,0) S RCEEOB=$$GET1^DIQ(344.41,RCLINE_","_RCERA_",",.02,"I") "RTN","RCDPEM5",448,0) ; Quit if ERA line pointer to EEOB is missing "RTN","RCDPEM5",449,0) Q:'RCEEOB 0 "RTN","RCDPEM5",450,0) ; Ignore EEOB if status is not removed - read access to file #361.1 under IA 4051 "RTN","RCDPEM5",451,0) Q:$$GET1^DIQ(361.1,RCEEOB_",",102,"I")'=1 0 "RTN","RCDPEM5",452,0) ; Return suspended EEOB IEN "RTN","RCDPEM5",453,0) Q RCEEOB "RTN","RCDPEM5",454,0) ; "RTN","RCDPEM5",455,0) ; EP RCDPRPL1 and RCDPLPL3 "RTN","RCDPEM5",456,0) RESTORE(RCPTDA,RCTRANDA,ORIG,SRC) ; Change bill number on EOB and clear 'removed' status "RTN","RCDPEM5",457,0) ; "RTN","RCDPEM5",458,0) ; INPUT - RCPTDA - Receipt ien #344 "RTN","RCDPEM5",459,0) ; - RCTRANDA - Receipt line #344.01 "RTN","RCDPEM5",460,0) ; - ORIG - EOB ien #361.1 "RTN","RCDPEM5",461,0) ; - SRC - 'L' - Link Payments 'R' - Receipt Porcessing "RTN","RCDPEM5",462,0) ; "RTN","RCDPEM5",463,0) Q:'$$LOCK^IBCEOB4(ORIG) "RTN","RCDPEM5",464,0) ; "RTN","RCDPEM5",465,0) W !,"Updating EEOB...." "RTN","RCDPEM5",466,0) ; "RTN","RCDPEM5",467,0) N NCLAIM,JUST "RTN","RCDPEM5",468,0) ; Get new claim IEN from receipt line "RTN","RCDPEM5",469,0) S NCLAIM=$P($$GET1^DIQ(344.01,RCTRANDA_","_RCPTDA_",",.09,"I"),";") "RTN","RCDPEM5",470,0) ; Set up justification text "RTN","RCDPEM5",471,0) S JUST="EEOB restored from suspense in "_$S(SRC="L":"Link Payments",SRC="R":"Edit Payments",1:"Other") "RTN","RCDPEM5",472,0) ; Update AR comments on 'from claim' "RTN","RCDPEM5",473,0) D AUDIT^RCDPAYER(ORIG,JUST,"W") "RTN","RCDPEM5",474,0) ; Change claim number on EOB "RTN","RCDPEM5",475,0) D MOVE^IBCEOB4(ORIG,NCLAIM,DUZ,$$NOW^XLFDT,JUST,"M") "RTN","RCDPEM5",476,0) ; Reset EEOB REMOVED status "RTN","RCDPEM5",477,0) D RESTORE^IBCEOB4(ORIG) "RTN","RCDPEM5",478,0) ;Unlock EOB "RTN","RCDPEM5",479,0) D UNLOCK^IBCEOB4(ORIG) "RTN","RCDPEM5",480,0) ; "RTN","RCDPEM5",481,0) H 1 W "done" "RTN","RCDPEM5",482,0) Q "RTN","RCDPEM9") 0^30^B81919705 "RTN","RCDPEM9",1,0) RCDPEM9 ;OIFO-BAYPINES/PJH - PAYER SELECTION ;10/18/11 6:17pm "RTN","RCDPEM9",2,0) ;;4.5;Accounts Receivable;**276,284,318,326,332**;Mar 20, 1995;Build 40 "RTN","RCDPEM9",3,0) ;;Per VA Directive 6402, this routine should not be modified. "RTN","RCDPEM9",4,0) ; "RTN","RCDPEM9",5,0) ; PRCA*4.5*318 - Added parameters MIXED and BLANKLN "RTN","RCDPEM9",6,0) ; PRCA*4.5*326 - Extensive rewrite to include selection/sort by payer TIN in the Auto Post Report "RTN","RCDPEM9",7,0) GETPAY(FILE,MIXED,BLANKLN,NMORTIN,SHOWTIN) ; Let user select payer for filter "RTN","RCDPEM9",8,0) ; Input: FILE - File to retrieve Payers from either #344.4 OR ##344.31 "RTN","RCDPEM9",9,0) ; MIXED - 1 to display prompts in mixed case "RTN","RCDPEM9",10,0) ; Optional, defaults to 0 "RTN","RCDPEM9",11,0) ; BLANKLN - 0 skip initial blank line "RTN","RCDPEM9",12,0) ; Optional, defaults to 1 "RTN","RCDPEM9",13,0) ; NMORTIN - 1 to look-up Payer by Payer Name, 2 to look-up by TIN "RTN","RCDPEM9",14,0) ; 0 or undefined - pre-326 behavior, look-up by payer name and don't include TIN in output array. "RTN","RCDPEM9",15,0) ; Optional, defaults to 0 "RTN","RCDPEM9",16,0) ; SHOWTIN - 1 to append the Payer Name or Payer TIN when displaying payers "RTN","RCDPEM9",17,0) ; Optional, defaults to 0 "RTN","RCDPEM9",18,0) ; Output: ^TMP("RCSELPAY",$J) - Array of selected Payers "RTN","RCDPEM9",19,0) ; Returns: A1^A2^A3 Where: "RTN","RCDPEM9",20,0) ; A1 - -1 - None selected "RTN","RCDPEM9",21,0) ; 1 - Range of payers "RTN","RCDPEM9",22,0) ; 2 - All payers selected "RTN","RCDPEM9",23,0) ; 3 - Specific payers "RTN","RCDPEM9",24,0) ; A2 - From Range (When a from/thru range is selected by user) "RTN","RCDPEM9",25,0) ; A3 - Thru Range (When a from/thru range is selected by user) "RTN","RCDPEM9",26,0) N CNT,DIR,DIROUT,DIRUT,DTOUT,DUOUT,I,IEN,INDX "RTN","RCDPEM9",27,0) N RCANS,RCANS2,RCINC,RCINSF,RCINST,RCPAY,RNG1,RNG2,RTNFLG,TIN,X,XX,Y "RTN","RCDPEM9",28,0) S:'$D(MIXED) MIXED=0 ; PRCA*4.5*318 - Added logic for MIXED and BLANKLN "RTN","RCDPEM9",29,0) S:'$D(BLANKLN) BLANKLN=1 "RTN","RCDPEM9",30,0) S:'$D(NMORTIN) NMORTIN=0 "RTN","RCDPEM9",31,0) S:'$D(SHOWTIN) SHOWTIN=0 "RTN","RCDPEM9",32,0) ; "RTN","RCDPEM9",33,0) S RTNFLG=0,INDX=1,RNG1="",RNG2="" "RTN","RCDPEM9",34,0) K ^TMP("RCSELPAY",$J) ; Clear list of selected Payers "RTN","RCDPEM9",35,0) ; "RTN","RCDPEM9",36,0) ; Select option required (All, Selected or Range) "RTN","RCDPEM9",37,0) I NMORTIN=2 D "RTN","RCDPEM9",38,0) . S DIR(0)="SA^A:ALL;S:SPECIFIC" "RTN","RCDPEM9",39,0) . S:MIXED DIR("A")="Run Report for (A)LL or (S)PECIFIC Insurance Companies?: " "RTN","RCDPEM9",40,0) . S:'MIXED DIR("A")="RUN REPORT FOR (A)LL OR (S)PECIFIC INSURANCE COMPANIES?: " "RTN","RCDPEM9",41,0) E D "RTN","RCDPEM9",42,0) . S DIR(0)="SA^A:ALL;S:SPECIFIC;R:RANGE" "RTN","RCDPEM9",43,0) . S:MIXED DIR("A")="Run Report for (A)LL, (S)PECIFIC, or (R)ANGE of Insurance Companies?: " "RTN","RCDPEM9",44,0) . S:'MIXED DIR("A")="RUN REPORT FOR (A)LL, (S)PECIFIC, OR (R)ANGE OF INSURANCE COMPANIES?: " "RTN","RCDPEM9",45,0) . S DIR("?",2)="Enter 'RANGE' to select an Insurance Company range." "RTN","RCDPEM9",46,0) S DIR("B")="ALL" "RTN","RCDPEM9",47,0) S DIR("?",1)="Enter 'ALL' to select all Insurance Companies." "RTN","RCDPEM9",48,0) S DIR("?")="Enter 'SPECIFIC' to select specific Insurance Companies." "RTN","RCDPEM9",49,0) W:BLANKLN ! ; PRCA*4.5*318 - Added condition for BLANKLN "RTN","RCDPEM9",50,0) D ^DIR K DIR "RTN","RCDPEM9",51,0) ; "RTN","RCDPEM9",52,0) ; Abort on ^ exit or timeout "RTN","RCDPEM9",53,0) I $D(DTOUT)!$D(DUOUT) S RTNFLG=-1 Q RTNFLG "RTN","RCDPEM9",54,0) ; "RTN","RCDPEM9",55,0) ; ALL payers "RTN","RCDPEM9",56,0) ; Switch to use new Payer Name/Payer TIN index "RTN","RCDPEM9",57,0) I Y="A" D "RTN","RCDPEM9",58,0) . S CNT=0,RCPAY="",RTNFLG=2 "RTN","RCDPEM9",59,0) . F S RCPAY=$O(^RCY(FILE,"C",RCPAY)) Q:RCPAY="" D "RTN","RCDPEM9",60,0) . . S CNT=CNT+1,IEN=$O(^RCY(FILE,"C",RCPAY,"")) "RTN","RCDPEM9",61,0) . . S TIN=$$GET1^DIQ(FILE,IEN,.03,"E") "RTN","RCDPEM9",62,0) . . S XX=$S(NMORTIN=2:TIN_"/"_RCPAY,NMORTIN=1:RCPAY_"/"_TIN,1:RCPAY) "RTN","RCDPEM9",63,0) . . S ^TMP("RCSELPAY",$J,CNT)=XX "RTN","RCDPEM9",64,0) ; "RTN","RCDPEM9",65,0) ; Selected Payers "RTN","RCDPEM9",66,0) I Y="S" D "RTN","RCDPEM9",67,0) . D GLIST(FILE,NMORTIN),GETPAYS(CNT,MIXED,NMORTIN) ; PRCA*4.5*318 - Added parameter MIXED "RTN","RCDPEM9",68,0) ; "RTN","RCDPEM9",69,0) ; Range of Payers "RTN","RCDPEM9",70,0) I Y="R" D "RTN","RCDPEM9",71,0) . D GLIST(FILE,NMORTIN),GETPAYR(MIXED,BLANKLN) ; PRCA*4.5*318 - Added parameters MIXED and BLANKLN "RTN","RCDPEM9",72,0) ; "RTN","RCDPEM9",73,0) K:RTNFLG'=2 ^TMP("RCPAYER",$J) ; Clear list of all payers "RTN","RCDPEM9",74,0) K:RTNFLG=-1 ^TMP("RCSELPAY",$J) ; Aborting, clear any selected payers "RTN","RCDPEM9",75,0) ; "RTN","RCDPEM9",76,0) ; PRCA*4.5*284 - Update return value to include from/thru range. See above for documentation "RTN","RCDPEM9",77,0) Q RTNFLG_"^"_RNG1_"^"_RNG2 ; Return value "RTN","RCDPEM9",78,0) ; "RTN","RCDPEM9",79,0) GLIST(FILE,NMORTIN) ; Build list for this file "RTN","RCDPEM9",80,0) ; Input: FILE - File to retrieve Payers from either #344.4 OR ##344.31 "RTN","RCDPEM9",81,0) ; NMORTIN - 2 - lookup by TIN, 1 - lookup by Payer Name, 0 - pre 326 behavior "RTN","RCDPEM9",82,0) ; Output: ^TMP("RCPAYER",$J,A1)=A2 Where: "RTN","RCDPEM9",83,0) ; A1 - Counter "RTN","RCDPEM9",84,0) ; A2 - Payer Name/TIN if NMORTIN=1, TIN/Payer Name if NMORTIN=2, else Payer Name "RTN","RCDPEM9",85,0) ; ^TMP("RCPAYER",$J,"B",B1,B2)=B3 Where: "RTN","RCDPEM9",86,0) ; B1 - Payer TIN if NMORTIN=2, else Payer Name "RTN","RCDPEM9",87,0) ; B2 - Counter "RTN","RCDPEM9",88,0) ; B3 - Payer Name if NMORTIN=0 or 1, else Payer TIN "RTN","RCDPEM9",89,0) N IEN,PAYNAM,TIN "RTN","RCDPEM9",90,0) K ^TMP("RCPAYER",$J) ; Clear workfile "RTN","RCDPEM9",91,0) I NMORTIN=2 D Q ; Build list of Payers by TIN "RTN","RCDPEM9",92,0) . S CNT=0,TIN="" "RTN","RCDPEM9",93,0) . F S TIN=$O(^RCY(FILE,"ATP",TIN)) Q:TIN="" D "RTN","RCDPEM9",94,0) . . S PAYNAM="" "RTN","RCDPEM9",95,0) . . F S PAYNAM=$O(^RCY(FILE,"ATP",TIN,PAYNAM)) Q:PAYNAM="" D "RTN","RCDPEM9",96,0) . . . S CNT=CNT+1 "RTN","RCDPEM9",97,0) . . . S ^TMP("RCPAYER",$J,CNT)=TIN_"/"_PAYNAM "RTN","RCDPEM9",98,0) . . . S ^TMP("RCPAYER",$J,"B",TIN,CNT)=PAYNAM "RTN","RCDPEM9",99,0) ; "RTN","RCDPEM9",100,0) S CNT=0,PAYNAM="" "RTN","RCDPEM9",101,0) F S PAYNAM=$O(^RCY(FILE,"APT",PAYNAM)) Q:PAYNAM="" D "RTN","RCDPEM9",102,0) . S TIN="" "RTN","RCDPEM9",103,0) . F S TIN=$O(^RCY(FILE,"APT",PAYNAM,TIN)) Q:TIN="" D "RTN","RCDPEM9",104,0) . . S CNT=CNT+1 "RTN","RCDPEM9",105,0) . . S ^TMP("RCPAYER",$J,CNT)=$S(NMORTIN=1:PAYNAM_"/"_TIN,1:PAYNAM) "RTN","RCDPEM9",106,0) . . S ^TMP("RCPAYER",$J,"B",PAYNAM,CNT)=TIN "RTN","RCDPEM9",107,0) Q "RTN","RCDPEM9",108,0) ; "RTN","RCDPEM9",109,0) ; PRCA*4.5*318 - Added parameter & logic for MIXED "RTN","RCDPEM9",110,0) GETPAYS(CNT,MIXED,NMORTIN) ; Select Specific payer for filter "RTN","RCDPEM9",111,0) ; Input: CNT - Number of Payers "RTN","RCDPEM9",112,0) ; MIXED - 1 to display prompts in mixed case "RTN","RCDPEM9",113,0) ; Optional, defaults to 0 "RTN","RCDPEM9",114,0) ; NMORTIN - 2 to lookup by TIN, 1 to lookup by Payer, 0 - Pre 326 behavior "RTN","RCDPEM9",115,0) ; Optional, defaults to 0 "RTN","RCDPEM9",116,0) ; Output: RTNFLG -1 - No Payer selected "RTN","RCDPEM9",117,0) ; 3 - At least one Payer selected "RTN","RCDPEM9",118,0) S:'$D(MIXED) MIXED=0 "RTN","RCDPEM9",119,0) S:'$D(NMORTIN) NMORTIN=0 "RTN","RCDPEM9",120,0) K ^TMP("RCDPEM9",$J) "RTN","RCDPEM9",121,0) F Q:RTNFLG'=0 D "RTN","RCDPEM9",122,0) . N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y "RTN","RCDPEM9",123,0) . S DIR("A")="SELECT INSURANCE COMPANY" "RTN","RCDPEM9",124,0) . S:MIXED DIR("A")="Select Insurance Company "_$S(NMORTIN=2:"TIN",1:"NAME") ; PRCA*4.5*318 "RTN","RCDPEM9",125,0) . S DIR(0)="FO^1:30" "RTN","RCDPEM9",126,0) . S DIR("?")="ENTER THE "_$S(NMORTIN=2:"TIN",1:"NAME")_" OF THE PAYER OR '??' TO LIST PAYERS" "RTN","RCDPEM9",127,0) . ; PRCA*4.5*318 - Added MIXED "RTN","RCDPEM9",128,0) . S:MIXED DIR("?")="Enter the "_$S(NMORTIN=2:"TIN",1:"name")_" of the payer or '??' to list payers" "RTN","RCDPEM9",129,0) . S DIR("??")="^D LIST^RCDPEM9(CNT)" "RTN","RCDPEM9",130,0) . D ^DIR K DIR "RTN","RCDPEM9",131,0) . ; "RTN","RCDPEM9",132,0) . ; User pressed ENTER "RTN","RCDPEM9",133,0) . I Y="",'$D(DTOUT) S RTNFLG=$S($D(^TMP("RCSELPAY",$J)):3,1:-1) Q "RTN","RCDPEM9",134,0) . ; "RTN","RCDPEM9",135,0) . ; First check for exits "RTN","RCDPEM9",136,0) . I $D(DUOUT)!$D(DTOUT)!$D(DIRUT)!$D(DIROUT) S RTNFLG=-1 Q "RTN","RCDPEM9",137,0) . S (RCANS,RCANS2)="",RCANS=Y "RTN","RCDPEM9",138,0) . I NMORTIN=2 D Q ; TIN lookup "RTN","RCDPEM9",139,0) . . I '$D(^TMP("RCPAYER",$J,"B",RCANS)) D Q "RTN","RCDPEM9",140,0) . . . W " ??" "RTN","RCDPEM9",141,0) . . I $D(^TMP("RCDPEM9",$J,RCANS)) D Q "RTN","RCDPEM9",142,0) . . . W:'MIXED " ?? PAYER ALREADY SELECTED" "RTN","RCDPEM9",143,0) . . . W:MIXED " ?? Payer already selected" "RTN","RCDPEM9",144,0) . . D SELTIN(RCANS,.INDX) "RTN","RCDPEM9",145,0) . ; "RTN","RCDPEM9",146,0) . ; Check for Partial Match on user input "RTN","RCDPEM9",147,0) . I '(RCANS?.N) D Q:'$G(RCANS2) "RTN","RCDPEM9",148,0) . . S RCANS2=$O(^TMP("RCPAYER",$J,"B",RCANS,RCANS2)) "RTN","RCDPEM9",149,0) . . D:'RCANS2 PART(NMORTIN,RCANS,.INDX) "RTN","RCDPEM9",150,0) . S:$G(RCANS2) RCANS=RCANS2 "RTN","RCDPEM9",151,0) . I RCANS="" W " ??" Q "RTN","RCDPEM9",152,0) . I RCANS?.N,((+RCANS<1)!(+RCANS>CNT)) W " ??" Q "RTN","RCDPEM9",153,0) . I RCANS'?.N W " ??" Q "RTN","RCDPEM9",154,0) . I $D(^TMP("RCDPEM9",$J,RCANS)) D Q "RTN","RCDPEM9",155,0) . . W:'MIXED " ?? PAYER ALREADY SELECTED" "RTN","RCDPEM9",156,0) . . W:MIXED " ?? Payer already selected" "RTN","RCDPEM9",157,0) . S ^TMP("RCDPEM9",$J,RCANS)="" "RTN","RCDPEM9",158,0) . W " ",^TMP("RCPAYER",$J,RCANS) "RTN","RCDPEM9",159,0) . S ^TMP("RCSELPAY",$J,INDX)=$G(^TMP("RCPAYER",$J,RCANS)) "RTN","RCDPEM9",160,0) . S INDX=INDX+1 "RTN","RCDPEM9",161,0) K ^TMP("RCDPEM9",$J) "RTN","RCDPEM9",162,0) Q "RTN","RCDPEM9",163,0) ; "RTN","RCDPEM9",164,0) SELTIN(TIN,INDX) ; Show all the payers with the selected TIN and ask the user "RTN","RCDPEM9",165,0) ; if they want to select the TIN "RTN","RCDPEM9",166,0) ; Input: TIN - User Selected TIN "RTN","RCDPEM9",167,0) ; INDX - Current # of selected Payers "RTN","RCDPEM9",168,0) ; ^TMP("RCPAYER",$J,"B") - Array of TINs on file "RTN","RCDPEM9",169,0) ; ^TMP("RCSELPAY",$J,A1)= A2/A3 Current Selected Payers Where: "RTN","RCDPEM9",170,0) ; A1 - Counter "RTN","RCDPEM9",171,0) ; A2 - Selected TIN "RTN","RCDPEM9",172,0) ; A3 - Selected PAYER "RTN","RCDPEM9",173,0) ; Output: INDX - Updated # of selected Payers "RTN","RCDPEM9",174,0) ; ^TMP("RCSELPAY",$J,A1)= A2/A3 Updated Selected Payers Where: "RTN","RCDPEM9",175,0) ; A1 - Counter "RTN","RCDPEM9",176,0) ; A2 - Selected TIN "RTN","RCDPEM9",177,0) ; A3 - Selected PAYER "RTN","RCDPEM9",178,0) N CTR,DIR,DIROUT,DIRUT,DTOUT,DUOUT,SELPAY,X,Y "RTN","RCDPEM9",179,0) W !,"The following Payers with TIN ",TIN," have ERAs on file" "RTN","RCDPEM9",180,0) D PART(2,TIN,INDX,.SELPAY) "RTN","RCDPEM9",181,0) S DIR(0)="Y" "RTN","RCDPEM9",182,0) S DIR("A")="Select this TIN" "RTN","RCDPEM9",183,0) S DIR("B")="YES" "RTN","RCDPEM9",184,0) D ^DIR "RTN","RCDPEM9",185,0) Q:$D(DTOUT)!$D(DUOUT) "RTN","RCDPEM9",186,0) Q:Y=0 "RTN","RCDPEM9",187,0) M ^TMP("RCSELPAY",$J)=SELPAY("RCSELPAY") "RTN","RCDPEM9",188,0) S INDX=$O(SELPAY("RCSELPAY",""),-1)+1 "RTN","RCDPEM9",189,0) Q "RTN","RCDPEM9",190,0) ; "RTN","RCDPEM9",191,0) LIST(CNT) ; Display all the Payers "RTN","RCDPEM9",192,0) ; Prompt users for stations to be used for filtering "RTN","RCDPEM9",193,0) ; Input: CNT - Total # of Payers in tmp file "RTN","RCDPEM9",194,0) ; ^TMP("RCPAYER",$J,A1)=A2 Where: "RTN","RCDPEM9",195,0) ; A1 - Counter "RTN","RCDPEM9",196,0) ; A2 - Payer Name/TIN if NMORTIN=1, TIN/Payer Name if NMORTIN=2, else Payer Name "RTN","RCDPEM9",197,0) N I "RTN","RCDPEM9",198,0) F I=1:1:CNT D "RTN","RCDPEM9",199,0) . W !,I,".",?5,$G(^TMP("RCPAYER",$J,I)) "RTN","RCDPEM9",200,0) Q "RTN","RCDPEM9",201,0) ; "RTN","RCDPEM9",202,0) PART(NMORTIN,RCANS,INDX,SELPAY) ; Give the user a list of partial matches "RTN","RCDPEM9",203,0) ; Input: NMORTIN - 2 - Lookup by Payer TIN, 0 or 1 - Lookup by Payer Name "RTN","RCDPEM9",204,0) ; RCANS - User Payer or TIN selection "RTN","RCDPEM9",205,0) ; INDX - Current # of selected Payers (only passed if NMORTIN=2) "RTN","RCDPEM9",206,0) ; Output: SELPAY()- Array of selected Payers (only returned if NMORTIN=2) "RTN","RCDPEM9",207,0) ; ^TMP("RCPAYER",$J,A1)=A2 Where: "RTN","RCDPEM9",208,0) ; A1 - Counter "RTN","RCDPEM9",209,0) ; A2 - Payer Name/TIN if NMORTIN=1, TIN/Payer Name if NMORTIN=2, else Payer Name "RTN","RCDPEM9",210,0) ; ^TMP("RCPAYER",$J,"B",B1,B2)=B3 Where: "RTN","RCDPEM9",211,0) ; B1 - Payer TIN if NMORTIN=0, else Payer Name "RTN","RCDPEM9",212,0) ; B2 - Counter "RTN","RCDPEM9",213,0) ; B3 - Payer Name if NMORTIN=0 or 1, else Payer TIN "RTN","RCDPEM9",214,0) ; Output: List of Payers that meet the partial match "RTN","RCDPEM9",215,0) N RCPAR,CNT,CTR,RCSAVE "RTN","RCDPEM9",216,0) S CNT=0,RCPAR=RCANS,RCPAR=$O(^TMP("RCPAYER",$J,"B",RCPAR),-1) "RTN","RCDPEM9",217,0) F D Q:RCPAR="" "RTN","RCDPEM9",218,0) . S RCPAR=$O(^TMP("RCPAYER",$J,"B",RCPAR)) "RTN","RCDPEM9",219,0) . Q:RCPAR="" "RTN","RCDPEM9",220,0) . I $E(RCPAR,1,$L(RCANS))'[RCANS S RCPAR="" Q "RTN","RCDPEM9",221,0) . S CTR=0 "RTN","RCDPEM9",222,0) . F D Q:CTR="" "RTN","RCDPEM9",223,0) . . S CTR=$O(^TMP("RCPAYER",$J,"B",RCPAR,CTR)) "RTN","RCDPEM9",224,0) . . Q:CTR="" "RTN","RCDPEM9",225,0) . . W !,?5 "RTN","RCDPEM9",226,0) . . W:NMORTIN'=2 CTR,"." "RTN","RCDPEM9",227,0) . . W ^TMP("RCPAYER",$J,CTR) "RTN","RCDPEM9",228,0) . . I NMORTIN=2 D "RTN","RCDPEM9",229,0) . . . S SELPAY("RCSELPAY",INDX)=^TMP("RCPAYER",$J,CTR),INDX=INDX+1 "RTN","RCDPEM9",230,0) . . S CNT=CNT+1 "RTN","RCDPEM9",231,0) . . I CNT=1 S RCSAVE=^TMP("RCPAYER",$J,CTR) "RTN","RCDPEM9",232,0) W:'CNT " ??" "RTN","RCDPEM9",233,0) I NMORTIN'=2,CNT=1 D ; one match by name, select it automatically "RTN","RCDPEM9",234,0) . S ^TMP("RCSELPAY",$J,INDX)=RCSAVE,INDX=INDX+1 "RTN","RCDPEM9",235,0) . W " - SELECTED" "RTN","RCDPEM9",236,0) Q "RTN","RCDPEM9",237,0) ; "RTN","RCDPEM9",238,0) ; PRCA*4.5*318 - Added parameters & logic for MIXED & BLANKLN "RTN","RCDPEM9",239,0) GETPAYR(MIXED,BLANKLN) ;select payer for filter, range "RTN","RCDPEM9",240,0) ; called from ^RCDPEAR1 "RTN","RCDPEM9",241,0) ; Input: MIXED - 1 to display prompts in mixed case "RTN","RCDPEM9",242,0) ; Optional, defaults to 0 "RTN","RCDPEM9",243,0) ; BLANKLN - 0 skip initial blank line "RTN","RCDPEM9",244,0) ; Optional, defaults to 1 "RTN","RCDPEM9",245,0) ; "RTN","RCDPEM9",246,0) S:'$D(MIXED) MIXED=0 ; PRCA*4.5*318 "RTN","RCDPEM9",247,0) S:'$D(BLANKLN) BLANKLN=1 "RTN","RCDPEM9",248,0) ; "RTN","RCDPEM9",249,0) N DIR,DTOUT,DUOUT,DIRUT,DIROUT,INDX,X,Y,RCINSF,RCINST,NUM "RTN","RCDPEM9",250,0) S DIR("?")="ENTER THE NAME OF THE PAYER OR '??' TO LIST PAYERS" "RTN","RCDPEM9",251,0) S DIR("??")="^D LIST^RCDPEM9(CNT)" "RTN","RCDPEM9",252,0) S DIR(0)="FA^1:30^K:X'?1.U.E X" "RTN","RCDPEM9",253,0) S DIR("A")="START WITH INSURANCE COMPANY NAME: " "RTN","RCDPEM9",254,0) S DIR("B")=$E($O(^TMP("RCPAYER",$J,"B","")),1,30) "RTN","RCDPEM9",255,0) I MIXED D ;PRCA*4.5*318 "RTN","RCDPEM9",256,0) . S DIR("?")="Enter the name of the payer or '??' to list payers" "RTN","RCDPEM9",257,0) . S DIR("A")="Start with Insurance Company name: " "RTN","RCDPEM9",258,0) D ^DIR K DIR "RTN","RCDPEM9",259,0) I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT)!(Y="") S RTNFLG=-1 Q "RTN","RCDPEM9",260,0) S RCINSF=Y "RTN","RCDPEM9",261,0) S DIR("?")="ENTER THE NAME OF THE PAYER OR '??' TO LIST PAYERS" "RTN","RCDPEM9",262,0) S DIR("??")="^D LIST^RCDPEM9(CNT)" "RTN","RCDPEM9",263,0) S DIR(0)="FA^1:30^K:X'?1.U.E X" "RTN","RCDPEM9",264,0) S DIR("A")="GO TO INSURANCE COMPANY NAME: " "RTN","RCDPEM9",265,0) I MIXED D ;PRCA*4.5*318 "RTN","RCDPEM9",266,0) . S DIR("?")="Enter the name of the payer or '??' to list payers" "RTN","RCDPEM9",267,0) . S DIR("A")="Go to Insurance Company name: " "RTN","RCDPEM9",268,0) S DIR("B")=$E($O(^TMP("RCPAYER",$J,"B",""),-1),1,30) "RTN","RCDPEM9",269,0) ; PRCA*4.5*318 - added conditional for MIXED & BLANKLN "RTN","RCDPEM9",270,0) F W:BLANKLN ! D ^DIR Q:$S($D(DTOUT)!$D(DUOUT):1,1:RCINSF']Y) D "RTN","RCDPEM9",271,0) . W:'MIXED !,"'GO TO' NAME MUST COME AFTER 'START WITH' NAME" "RTN","RCDPEM9",272,0) . W:MIXED !,"'GO TO' name must come after 'START WITH' name" "RTN","RCDPEM9",273,0) K DIR "RTN","RCDPEM9",274,0) I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT)!(Y="") S RTNFLG=-1 Q "RTN","RCDPEM9",275,0) S RCINST=Y_"Z" ;entry of "ABC" will pick up "ABC INSURANCE" if "Z" is appended "RTN","RCDPEM9",276,0) ;If the first name is an exact match, back up to the previous entry "RTN","RCDPEM9",277,0) I $D(^TMP("RCPAYER",$J,"B",RCINSF)) S RCINSF=$O(^TMP("RCPAYER",$J,"B",RCINSF),-1) "RTN","RCDPEM9",278,0) ; PRCA*4.5*284 - Save from/thru user responses in RNG1 & RNG2 to rebuild after report is queued. Will be returned to the calling program. "RTN","RCDPEM9",279,0) S RNG1=RCINSF,RNG2=RCINST "RTN","RCDPEM9",280,0) S INDX=1 F S RCINSF=$O(^TMP("RCPAYER",$J,"B",RCINSF)) Q:RCINSF="" Q:RCINSF]RCINST D "RTN","RCDPEM9",281,0) . S NUM=$O(^TMP("RCPAYER",$J,"B",RCINSF,"")) "RTN","RCDPEM9",282,0) . S ^TMP("RCSELPAY",$J,INDX)=$G(^TMP("RCPAYER",$J,NUM)) "RTN","RCDPEM9",283,0) . S INDX=INDX+1 "RTN","RCDPEM9",284,0) ;Set return value "RTN","RCDPEM9",285,0) I INDX=1 S RTNFLG=-1 Q ; no entries in selected range "RTN","RCDPEM9",286,0) S RTNFLG=1 "RTN","RCDPEM9",287,0) Q "RTN","RCDPEMA1") 0^2^B72907594 "RTN","RCDPEMA1",1,0) RCDPEMA1 ;EDE/FA - LIST ALL AUTO-POSTED RECEIPTS REPORT ;Nov 17, 2016 "RTN","RCDPEMA1",2,0) ;;4.5;Accounts Receivable;**332**;Mar 20, 1995;Build 40 "RTN","RCDPEMA1",3,0) ;Per VA Directive 6402, this routine should not be modified. "RTN","RCDPEMA1",4,0) ; "RTN","RCDPEMA1",5,0) Q ; no direct entry "RTN","RCDPEMA1",6,0) ; "RTN","RCDPEMA1",7,0) RPTOUT(INPUT) ;EP from RCDPEMAP "RTN","RCDPEMA1",8,0) ; Output the report to paper/screen, listman or excel "RTN","RCDPEMA1",9,0) ; Input: INPUT - See REPORT^RCDPEMAP for a complete description "RTN","RCDPEMA1",10,0) ; ^TMP($J,A1,"SEL",A2)=External Auto-Post Date "RTN","RCDPEMA1",11,0) ; ^TMP($J,A1,"SEL",A3)=External lower cased sort value (Payer or User) "RTN","RCDPEMA1",12,0) ; ^TMP($J,A1,"SEL",A2,A3,A4,A5)=B1^B2^B3^B4^B5 - if record passed filters Where: "RTN","RCDPEMA1",13,0) ; A1 - "RCDPE_MAP" "RTN","RCDPEMA1",14,0) ; A2 - Internal Auto-Post Date (primary sort) "RTN","RCDPEMA1",15,0) ; A3 - Secondary Sort Value (Payer or User Name) "RTN","RCDPEMA1",16,0) ; A4 - IEN for file 344.4 "RTN","RCDPEMA1",17,0) ; A5 - IEN for file 344.41 "RTN","RCDPEMA1",18,0) ; B1 - Payer Name "RTN","RCDPEMA1",19,0) ; B2 - User Name "RTN","RCDPEMA1",20,0) ; B3 - ERA # "RTN","RCDPEMA1",21,0) ; B4 - Claim # "RTN","RCDPEMA1",22,0) ; B5 - Trace # "RTN","RCDPEMA1",23,0) ; Output: ^TMP("RCDPE_MAP",$J,CTR)=Line - Array of display lines (no headers) "RTN","RCDPEMA1",24,0) ; for output to Listman "RTN","RCDPEMA1",25,0) ; Only set when A7-1 "RTN","RCDPEMA1",26,0) ; "RTN","RCDPEMA1",27,0) N A1,ADATE,DATA,EXCEL,FIRST,LNCNT,LSTMAN,OUTYPE,PAGE,PAYER,SORT,STOP,SVAL "RTN","RCDPEMA1",28,0) S (LNCNT,PAGE)=0 ; Initialize Line/Page counters "RTN","RCDPEMA1",29,0) S $P(INPUT,"^",9)=0 ; Line Counter for Listman output "RTN","RCDPEMA1",30,0) S SORT=$P(INPUT,"^",6) ; Secondary Sort by Payer or User? "RTN","RCDPEMA1",31,0) S EXCEL=$P(INPUT,"^",8) ; Output to Excel? "RTN","RCDPEMA1",32,0) S LSTMAN=$P(INPUT,"^",7) ; Output to Listman? "RTN","RCDPEMA1",33,0) S OUTYPE=$S(EXCEL:2,LSTMAN:1,1:0) "RTN","RCDPEMA1",34,0) S DATA=0,FIRST=1 "RTN","RCDPEMA1",35,0) I OUTYPE=2 D ; Excel Ouput - Print header line "RTN","RCDPEMA1",36,0) . S XX="Auto-Post Date^" "RTN","RCDPEMA1",37,0) . S XX=XX_$S(SORT=2:"Payer",1:"User")_"^" "RTN","RCDPEMA1",38,0) . S XX=XX_$S(SORT=2:"User",1:"Payer")_"^" "RTN","RCDPEMA1",39,0) . S XX=XX_"ERA #^Claim #^Trace #" "RTN","RCDPEMA1",40,0) . W !,XX "RTN","RCDPEMA1",41,0) . ; "RTN","RCDPEMA1",42,0) S A1="RCDPE_MAP",STOP=0 "RTN","RCDPEMA1",43,0) S ADATE="" "RTN","RCDPEMA1",44,0) F D Q:ADATE="" Q:STOP "RTN","RCDPEMA1",45,0) . S ADATE=$O(^TMP($J,A1,"SEL",ADATE)) "RTN","RCDPEMA1",46,0) . Q:ADATE="" "RTN","RCDPEMA1",47,0) . I OUTYPE=1 D ; Listman Output "RTN","RCDPEMA1",48,0) . . S XX=$P(INPUT,"^",9),XX=XX+1 "RTN","RCDPEMA1",49,0) . . I FIRST D ; "RTN","RCDPEMA1",50,0) . . . S FIRST=0 "RTN","RCDPEMA1",51,0) . . E D ; "RTN","RCDPEMA1",52,0) . . . S ^TMP(A1,$J,XX)="",XX=XX+1 "RTN","RCDPEMA1",53,0) . . S ^TMP(A1,$J,XX)="Auto-Post Date: "_^TMP($J,A1,"SEL",ADATE) "RTN","RCDPEMA1",54,0) . . S $P(INPUT,"^",9)=XX "RTN","RCDPEMA1",55,0) . ; "RTN","RCDPEMA1",56,0) . I 'OUTYPE D Q:STOP ; Output to Screen/Paper "RTN","RCDPEMA1",57,0) . . I FIRST D Q ; Initial Page Header "RTN","RCDPEMA1",58,0) . . . S FIRST=0 "RTN","RCDPEMA1",59,0) . . . D PHEADER(INPUT,.LNCNT,.PAGE) "RTN","RCDPEMA1",60,0) . . . W !,"Auto-Post Date: "_^TMP($J,A1,"SEL",ADATE) "RTN","RCDPEMA1",61,0) . . . S LNCNT=LNCNT+1 "RTN","RCDPEMA1",62,0) . . I (LNCNT+6)>IOSL D Q:STOP ; Page break "RTN","RCDPEMA1",63,0) . . . S STOP=$$ASKSTOP^RCDPEMAP() "RTN","RCDPEMA1",64,0) . . . Q:STOP "RTN","RCDPEMA1",65,0) . . . D PHEADER(INPUT,.LNCNT,.PAGE) ; Page Header "RTN","RCDPEMA1",66,0) . . I LNCNT>7 W ! S LNCNT=LNCNT+1 "RTN","RCDPEMA1",67,0) . . W !,"Auto-Post Date: "_^TMP($J,A1,"SEL",ADATE) "RTN","RCDPEMA1",68,0) . . S LNCNT=LNCNT+1 "RTN","RCDPEMA1",69,0) . D RPT2(.INPUT,A1,ADATE,SORT,OUTYPE,.LNCNT,.STOP,.DATA) "RTN","RCDPEMA1",70,0) I 'DATA,'EXCEL,'LSTMAN D "RTN","RCDPEMA1",71,0) . D PHEADER(INPUT,.LNCNT,.PAGE) "RTN","RCDPEMA1",72,0) I 'EXCEL D "RTN","RCDPEMA1",73,0) . S XX=$$ENDORPRT^RCDPEARL "RTN","RCDPEMA1",74,0) . I OUTYPE=1 D Q "RTN","RCDPEMA1",75,0) . . S YY=$P(INPUT,"^",9)+1 "RTN","RCDPEMA1",76,0) . . S $P(INPUT,"^",9)=YY "RTN","RCDPEMA1",77,0) . . S ^TMP(A1,$J,YY)=XX "RTN","RCDPEMA1",78,0) . W !,XX "RTN","RCDPEMA1",79,0) I (OUTYPE'=1),'STOP,$$ASKSTOP^RCDPEMAP() "RTN","RCDPEMA1",80,0) Q "RTN","RCDPEMA1",81,0) ; "RTN","RCDPEMA1",82,0) RPT2(INPUT,A1,ADATE,SORT,OUTYPE,LNCNT,STOP,DATA) ; Report Output Continued "RTN","RCDPEMA1",83,0) ; Input: INPUT - See REPORT^RCDPEMAP for detail "RTN","RCDPEMA1",84,0) ; ADATE - Internal Auto-Post Date "RTN","RCDPEMA1",85,0) ; SORT - 2 - Sort by User, 1 - Sort by Payer "RTN","RCDPEMA1",86,0) ; OUTYPE - 2 - Excel, 1 - Listman, 0 - Paper/Screen "RTN","RCDPEMA1",87,0) ; LNCNT - Current line count (only if OUTYPE=0) "RTN","RCDPEMA1",88,0) ; ^TMP($J,A1,"SEL",...) - See RPTOUT for details "RTN","RCDPEMA1",89,0) ; Output: LNCNT - Updated line count (only if OUTYPE=0) "RTN","RCDPEMA1",90,0) ; STOP - 1 if user quit out (only if OUTYPE=0) "RTN","RCDPEMA1",91,0) ; INPUT - 9th '^' piece update with current line # is OUTYPE=1 "RTN","RCDPEMA1",92,0) ; DATA - 1 if at least one line of data is fount "RTN","RCDPEMA1",93,0) ; ^TMP("RCDPE_MAP",$J,CTR) - Output lines for Listman (only if OUTYPE=1) "RTN","RCDPEMA1",94,0) N CURS,SVAL,LASTS,XX "RTN","RCDPEMA1",95,0) S SVAL="",XX=$O(^TMP($J,A1,"SEL",ADATE,"")) "RTN","RCDPEMA1",96,0) S LASTS=^TMP($J,A1,"SEL",ADATE,XX) "RTN","RCDPEMA1",97,0) F D Q:SVAL="" Q:STOP "RTN","RCDPEMA1",98,0) . S SVAL=$O(^TMP($J,A1,"SEL",ADATE,SVAL)) "RTN","RCDPEMA1",99,0) . Q:SVAL="" "RTN","RCDPEMA1",100,0) . S CURS=^TMP($J,A1,"SEL",ADATE,SVAL) ; Current lower case Payer or User Name "RTN","RCDPEMA1",101,0) . I OUTYPE=1 D ; Listman output "RTN","RCDPEMA1",102,0) . . S XX=$P(INPUT,"^",9) "RTN","RCDPEMA1",103,0) . . I CURS'=LASTS D "RTN","RCDPEMA1",104,0) . . . S XX=XX+1,^TMP(A1,$J,XX)="" "RTN","RCDPEMA1",105,0) . . S XX=XX+1,^TMP(A1,$J,XX)=" "_$S(SORT=2:"Payer: ",1:"User: ")_CURS "RTN","RCDPEMA1",106,0) . . S $P(INPUT,"^",9)=XX "RTN","RCDPEMA1",107,0) . ; "RTN","RCDPEMA1",108,0) . I 'OUTYPE D Q:STOP ; Output to Paper/Screen "RTN","RCDPEMA1",109,0) . . I (LNCNT+4)>IOSL D Q:STOP ; Page break "RTN","RCDPEMA1",110,0) . . . S STOP=$$ASKSTOP^RCDPEMAP() "RTN","RCDPEMA1",111,0) . . . Q:STOP "RTN","RCDPEMA1",112,0) . . . D PHEADER(INPUT,.LNCNT,.PAGE) ; Print Page Header "RTN","RCDPEMA1",113,0) . . . W !,"Auto-Post Date: "_^TMP($J,A1,"SEL",ADATE) "RTN","RCDPEMA1",114,0) . . . ; W !,CURS "RTN","RCDPEMA1",115,0) . . . S LNCNT=LNCNT+3 "RTN","RCDPEMA1",116,0) . . I CURS'=LASTS D "RTN","RCDPEMA1",117,0) . . . S LNCNT=LNCNT+1,LASTS=CURS "RTN","RCDPEMA1",118,0) . . . W ! "RTN","RCDPEMA1",119,0) . . W !," ",$S(SORT=2:"Payer: ",1:"User: "),CURS "RTN","RCDPEMA1",120,0) . . S LNCNT=LNCNT+1 "RTN","RCDPEMA1",121,0) . D RPT3(.INPUT,A1,ADATE,SORT,SVAL,OUTYPE,.LNCNT,.STOP,.DATA) "RTN","RCDPEMA1",122,0) Q "RTN","RCDPEMA1",123,0) ; "RTN","RCDPEMA1",124,0) RPT3(INPUT,A1,ADATE,SORT,SVAL,OUTYPE,LNCNT,STOP,DATA) ; Report Output Continued "RTN","RCDPEMA1",125,0) ; Input: INPUT - See REPORT^RCDPEMAP for detail "RTN","RCDPEMA1",126,0) ; ADATE - Internal Auto-Post Date "RTN","RCDPEMA1",127,0) ; SORT - 1 - Sort by User, 2 - Sort by Payer "RTN","RCDPEMA1",128,0) ; SVAL - Current sort value (Upper cased Payer or User Name) "RTN","RCDPEMA1",129,0) ; OUTYPE - 2 - Excel, 1 - Listman, 0 - Paper/Screen "RTN","RCDPEMA1",130,0) ; LNCNT - Current line count (only if OUTYPE=0) "RTN","RCDPEMA1",131,0) ; ^TMP($J,A1,"SEL",...2) - See RPTOUT for details "RTN","RCDPEMA1",132,0) ; Output: LNCNT - Updated line count (only if OUTYPE=0) "RTN","RCDPEMA1",133,0) ; STOP - 1 if user quit out (only if OUTYPE=0) "RTN","RCDPEMA1",134,0) ; INPUT - 9th '^' piece update with current line # is OUTYPE=1 "RTN","RCDPEMA1",135,0) ; DATA - 1 if at least one line of data is found "RTN","RCDPEMA1",136,0) ; ^TMP("RCDPE_MAP",$J,CTR) - Output lines for Listman (only if OUTYPE=1) "RTN","RCDPEMA1",137,0) N DATAR,FIRSTS,IEN3444,IEN34441,LN1,LN2,LN3,UORP,UORPF,UORPL,XX,YY "RTN","RCDPEMA1",138,0) S IEN3444="",FIRSTS=1,UORPF=1 "RTN","RCDPEMA1",139,0) F D Q:IEN3444="" Q:STOP "RTN","RCDPEMA1",140,0) . S IEN3444=$O(^TMP($J,A1,"SEL",ADATE,SVAL,IEN3444)) "RTN","RCDPEMA1",141,0) . Q:IEN3444="" "RTN","RCDPEMA1",142,0) . S IEN34441="" "RTN","RCDPEMA1",143,0) . S XX=$O(^TMP($J,A1,"SEL",ADATE,SVAL,IEN3444,"")) "RTN","RCDPEMA1",144,0) . S XX=^TMP($J,A1,"SEL",ADATE,SVAL,IEN3444,XX) "RTN","RCDPEMA1",145,0) . S UORPL=$P(XX,"^",SORT) "RTN","RCDPEMA1",146,0) . F D Q:IEN34441="" "RTN","RCDPEMA1",147,0) . . S IEN34441=$O(^TMP($J,A1,"SEL",ADATE,SVAL,IEN3444,IEN34441)) "RTN","RCDPEMA1",148,0) . . Q:IEN34441="" "RTN","RCDPEMA1",149,0) . . S DATA=1 ; found data "RTN","RCDPEMA1",150,0) . . ; "RTN","RCDPEMA1",151,0) . . S DATAR=^TMP($J,A1,"SEL",ADATE,SVAL,IEN3444,IEN34441) "RTN","RCDPEMA1",152,0) . . S:SORT=2 LN1=" Payer: "_$P(DATAR,"^",1),LN2=" User: "_$P(DATAR,"^",2) "RTN","RCDPEMA1",153,0) . . S:SORT=1 LN1=" User: "_$P(DATAR,"^",2),LN2=" Payer: "_$P(DATAR,"^",1) "RTN","RCDPEMA1",154,0) . . S LN3=$P(DATAR,"^",3) ; ERA # "RTN","RCDPEMA1",155,0) . . S YY=$P(DATAR,"^",4) ; Claim # "RTN","RCDPEMA1",156,0) . . S LN3=$$SETSTR^VALM1(YY,LN3,13,10) "RTN","RCDPEMA1",157,0) . . S YY=$P(DATAR,"^",5) ; Trace # "RTN","RCDPEMA1",158,0) . . S LN3=$$SETSTR^VALM1(YY,LN3,25,50) "RTN","RCDPEMA1",159,0) . . S UORP=$P(DATAR,"^",SORT) "RTN","RCDPEMA1",160,0) . . I OUTYPE=2 D Q ; Excel Output "RTN","RCDPEMA1",161,0) . . . S XX=^TMP($J,A1,"SEL",ADATE)_"^" "RTN","RCDPEMA1",162,0) . . . I SORT=1 D "RTN","RCDPEMA1",163,0) . . . . S XX=XX_$P(DATAR,"^",2)_"^"_$P(DATAR,"^",1) "RTN","RCDPEMA1",164,0) . . . E D "RTN","RCDPEMA1",165,0) . . . . S XX=XX_$P(DATAR,"^",1,2) "RTN","RCDPEMA1",166,0) . . . S XX=XX_"^"_$P(DATAR,"^",3,5) "RTN","RCDPEMA1",167,0) . . . W !,XX "RTN","RCDPEMA1",168,0) . . ; "RTN","RCDPEMA1",169,0) . . ; Listman output "RTN","RCDPEMA1",170,0) . . I OUTYPE=1 D RPT3LM(A1,.INPUT,.FIRSTS,.UORP,.UORPL,.UORPF,LN2,LN3) Q "RTN","RCDPEMA1",171,0) . . ; "RTN","RCDPEMA1",172,0) . . ; Output to Paper/Screen - check if we need a page break "RTN","RCDPEMA1",173,0) . . I (LNCNT+2)>IOSL D Q:STOP "RTN","RCDPEMA1",174,0) . . . S STOP=$$ASKSTOP^RCDPEMAP() "RTN","RCDPEMA1",175,0) . . . Q:STOP "RTN","RCDPEMA1",176,0) . . . D PHEADER(INPUT,.LNCNT,.PAGE) "RTN","RCDPEMA1",177,0) . . . W !,"Auto-Post Date: "_^TMP($J,A1,"SEL",ADATE) "RTN","RCDPEMA1",178,0) . . . S LNCNT=LNCNT+1 "RTN","RCDPEMA1",179,0) . . . W !,LN1 "RTN","RCDPEMA1",180,0) . . . S LNCNT=LNCNT+1 "RTN","RCDPEMA1",181,0) . . . W !,LN2 "RTN","RCDPEMA1",182,0) . . . S LNCNT=LNCNT+1 "RTN","RCDPEMA1",183,0) . . I UORP'=UORPL D "RTN","RCDPEMA1",184,0) . . . S UORPL=UORP,LNCNT=LNCT+2,UORPF=0 "RTN","RCDPEMA1",185,0) . . . I LNCNT>7 W ! S LNCNT=LNCNT+1 "RTN","RCDPEMA1",186,0) . . . W !,LN2 S LNCNT=LNCNT+1 "RTN","RCDPEMA1",187,0) . . I UORPF D "RTN","RCDPEMA1",188,0) . . . S LNCNT=LNCNT+1,UORPF=0 "RTN","RCDPEMA1",189,0) . . . W !,LN2 S LNCNT=LNCNT+1 "RTN","RCDPEMA1",190,0) . . W !,LN3 "RTN","RCDPEMA1",191,0) . . S LNCNT=LNCNT+1 "RTN","RCDPEMA1",192,0) Q "RTN","RCDPEMA1",193,0) ; "RTN","RCDPEMA1",194,0) RPT3LM(A1,INPUT,FIRSTS,UORP,UORPL,UORPF,LN2,LN3) ; Continue listman output "RTN","RCDPEMA1",195,0) ; Input: A1 - "RCDPE_MAP" "RTN","RCDPEMA1",196,0) ; INPUT - 9th piece contains the current listman line counter "RTN","RCDPEMA1",197,0) ; FIRSTS - 1 if this is the first Payer for the current date, 0 otherwise "RTN","RCDPEMA1",198,0) ; UORP - Current User or Payer Name (whichever we're not sorting by) "RTN","RCDPEMA1",199,0) ; UORPL - Current last User or Payer Name (whichever we're not sorting by) "RTN","RCDPEMA1",200,0) ; UORPF - 1 if this is the first user or payer for the current sor value "RTN","RCDPEMA1",201,0) ; 0 otherwise "RTN","RCDPEMA1",202,0) ; LN2 - Payer or User Name (whatever is not the sort) display line "RTN","RCDPEMA1",203,0) ; LN3 - ERA display line "RTN","RCDPEMA1",204,0) ; ^TMP(A1,$J,XX) - Current listman display lines "RTN","RCDPEMA1",205,0) ; Output: INPUT - Updated 9th piece contains the current listman line counter "RTN","RCDPEMA1",206,0) ; FIRSTS - Updated to 0 (potentially) "RTN","RCDPEMA1",207,0) ; UORP - Updated User or Payer Name (potentially) "RTN","RCDPEMA1",208,0) ; UORPL - Updated last User or Payer Name (potentially) "RTN","RCDPEMA1",209,0) ; UORPF - Updated "RTN","RCDPEMA1",210,0) ; ^TMP(A1,$J,XX) - Current listman display lines "RTN","RCDPEMA1",211,0) N XX "RTN","RCDPEMA1",212,0) S XX=$P(INPUT,"^",9) "RTN","RCDPEMA1",213,0) I UORPF D ; first User or Payer for sort value and date "RTN","RCDPEMA1",214,0) . S UORPF=0,XX=XX+1,UORPL=UORP "RTN","RCDPEMA1",215,0) . S ^TMP(A1,$J,XX)=LN2 "RTN","RCDPEMA1",216,0) I UORP'=UORPL D ; Different User or Payer for date "RTN","RCDPEMA1",217,0) . S UORPL=UORP,UORPF=0 "RTN","RCDPEMA1",218,0) . S XX=XX+1 "RTN","RCDPEMA1",219,0) . S ^TMP(A1,$J,XX)="" "RTN","RCDPEMA1",220,0) . S XX=XX+1 "RTN","RCDPEMA1",221,0) . S ^TMP(A1,$J,XX)=LN2 "RTN","RCDPEMA1",222,0) S XX=XX+1 "RTN","RCDPEMA1",223,0) S ^TMP(A1,$J,XX)=LN3 "RTN","RCDPEMA1",224,0) S $P(INPUT,"^",9)=XX "RTN","RCDPEMA1",225,0) Q "RTN","RCDPEMA1",226,0) ; "RTN","RCDPEMA1",227,0) PHEADER(INPUT,LNCNT,PAGE) ; Display a Page Header "RTN","RCDPEMA1",228,0) ; Input: INPUT - See REPORT for a complete description "RTN","RCDPEMA1",229,0) ; LNCNT - Current Line Count "RTN","RCDPEMA1",230,0) ; PAGE - Current Page Count "RTN","RCDPEMA1",231,0) ; Output: LNCNT - Updated Line Count "RTN","RCDPEMA1",232,0) ; PAGE - Updated Page Count "RTN","RCDPEMA1",233,0) N XX,YY,ZZ "RTN","RCDPEMA1",234,0) S YY="EEOBs Marked for Auto-Post Audit Report",PAGE=PAGE+1 "RTN","RCDPEMA1",235,0) S XX=$$NOW^XLFDT(),XX=$$FMTE^XLFDT(XX) "RTN","RCDPEMA1",236,0) S XX=$$SETSTR^VALM1(XX,YY,42,21) "RTN","RCDPEMA1",237,0) S YY="Page: "_$J(PAGE,3) "RTN","RCDPEMA1",238,0) S XX=$$SETSTR^VALM1(YY,XX,69,$L(YY)) "RTN","RCDPEMA1",239,0) W @IOF,XX "RTN","RCDPEMA1",240,0) S LNCNT=1 "RTN","RCDPEMA1",241,0) ; "RTN","RCDPEMA1",242,0) S XX=$$HDRLN2(INPUT) "RTN","RCDPEMA1",243,0) W !,XX "RTN","RCDPEMA1",244,0) S LNCNT=LNCNT+1 "RTN","RCDPEMA1",245,0) ; "RTN","RCDPEMA1",246,0) S XX=$$HDRLN3(INPUT) "RTN","RCDPEMA1",247,0) W !,XX "RTN","RCDPEMA1",248,0) S LNCNT=LNCNT+1 "RTN","RCDPEMA1",249,0) ; "RTN","RCDPEMA1",250,0) S XX=$$HDRLN4(INPUT) "RTN","RCDPEMA1",251,0) W !,XX "RTN","RCDPEMA1",252,0) S LNCNT=LNCNT+1 "RTN","RCDPEMA1",253,0) ; "RTN","RCDPEMA1",254,0) S LNCNT=LNCNT+1 "RTN","RCDPEMA1",255,0) W !,"ERA # Claim # Trace #" "RTN","RCDPEMA1",256,0) S LNCNT=LNCNT+1 "RTN","RCDPEMA1",257,0) W !,"--------------------------------------------------------------------------------" "RTN","RCDPEMA1",258,0) S LNCNT=LNCNT+1 "RTN","RCDPEMA1",259,0) Q "RTN","RCDPEMA1",260,0) ; "RTN","RCDPEMA1",261,0) HDRLN2(INPUT) ; Build the 2nd header line "RTN","RCDPEMA1",262,0) ; Input: INPUT - See REPORT^RCDPEMAP for a complete description "RTN","RCDPEMA1",263,0) ; Returns: Text for 2nd header line "RTN","RCDPEMA1",264,0) N XX "RTN","RCDPEMA1",265,0) S XX="Divs : "_$S($P(INPUT,"^",1)=1:"All",1:$$DIVS(.RCVAUTD)) "RTN","RCDPEMA1",266,0) Q XX "RTN","RCDPEMA1",267,0) ; "RTN","RCDPEMA1",268,0) HDRLN3(INPUT) ; Build the 3rd header line "RTN","RCDPEMA1",269,0) ; Input: INPUT - See REPORT^RCDPEMAP for a complete description "RTN","RCDPEMA1",270,0) ; Returns: Text for 3rd header line "RTN","RCDPEMA1",271,0) N XX,YY,ZZ "RTN","RCDPEMA1",272,0) S YY=$P(INPUT,"^",3) "RTN","RCDPEMA1",273,0) S XX="M/P/T: "_$S(YY="A":"All",YY="M":"Medical",YY="P":"Pharmacy ",1:"Tricare")_" - " "RTN","RCDPEMA1",274,0) S XX=XX_$S($P(INPUT,"^",4)="A":" All",1:" Sel")_" Payers" "RTN","RCDPEMA1",275,0) S YY=$P($P(INPUT,"^",2),"|",1),YY="Auto-Post Date: "_$$FMTE^XLFDT(YY,"2Z") "RTN","RCDPEMA1",276,0) S ZZ=$P($P(INPUT,"^",2),"|",2),ZZ=$$FMTE^XLFDT(ZZ,"2Z") "RTN","RCDPEMA1",277,0) S YY=YY_"-"_ZZ "RTN","RCDPEMA1",278,0) S XX=$$SETSTR^VALM1(YY,XX,40,$L(YY)) "RTN","RCDPEMA1",279,0) Q XX "RTN","RCDPEMA1",280,0) ; "RTN","RCDPEMA1",281,0) HDRLN4(INPUT) ; Build the 4th header line "RTN","RCDPEMA1",282,0) ; Input: INPUT - See REPORT^RCDPEMAP for a complete description "RTN","RCDPEMA1",283,0) ; Returns: Text for 4th header line "RTN","RCDPEMA1",284,0) N XX,YY,ZZ "RTN","RCDPEMA1",285,0) S YY=$P(INPUT,"^",4) "RTN","RCDPEMA1",286,0) S XX="Users: "_$S($P(INPUT,"^",5)=1:"All ",1:"Selected") "RTN","RCDPEMA1",287,0) S YY="Sort: "_$S($P(INPUT,"^",6)=1:"User ",1:"Payer ")_"Name" "RTN","RCDPEMA1",288,0) S XX=$$SETSTR^VALM1(YY,XX,50,$L(YY)) "RTN","RCDPEMA1",289,0) Q XX "RTN","RCDPEMA1",290,0) ; "RTN","RCDPEMA1",291,0) DIVS(VAUTD) ; "RTN","RCDPEMA1",292,0) ; Input - VAUTD array of divisions selected "RTN","RCDPEMA1",293,0) ; Returns - List of station numbers "RTN","RCDPEMA1",294,0) N RETURN,XX,Z0,Z1 "RTN","RCDPEMA1",295,0) S Z1="" "RTN","RCDPEMA1",296,0) S Z0=0 "RTN","RCDPEMA1",297,0) F D Q:'Z0 "RTN","RCDPEMA1",298,0) . S Z0=$O(VAUTD(Z0)) "RTN","RCDPEMA1",299,0) . Q:'Z0 "RTN","RCDPEMA1",300,0) . S XX=$$GET1^DIQ(40.8,Z0,1,"I") ;Facility Number ;PRCA*4.5*321 "RTN","RCDPEMA1",301,0) . S Z1=Z1_XX_", " "RTN","RCDPEMA1",302,0) S RETURN=$E(Z1,1,$L(Z1)-2) "RTN","RCDPEMA1",303,0) Q RETURN "RTN","RCDPEMAP") 0^1^B105695606 "RTN","RCDPEMAP",1,0) RCDPEMAP ;AITC/FA - LIST ALL AUTO-POSTED RECEIPTS REPORT ;Nov 17, 2016 "RTN","RCDPEMAP",2,0) ;;4.5;Accounts Receivable;**332**;Mar 20, 1995;Build 40 "RTN","RCDPEMAP",3,0) ;Per VA Directive 6402, this routine should not be modified. "RTN","RCDPEMAP",4,0) ; "RTN","RCDPEMAP",5,0) EN ; Main entry point "RTN","RCDPEMAP",6,0) N INPUT,RCPAR,RCVAUTD,XX,YY "RTN","RCDPEMAP",7,0) K ^TMP($J,"RCDPE_MAP"),^TMP("RCDPE_MAP",$J) "RTN","RCDPEMAP",8,0) K ^TMP("RCSELPAY",$J),^TMP($J,"SELPAYER"),^TMP($J,"SELUSER") "RTN","RCDPEMAP",9,0) ; "RTN","RCDPEMAP",10,0) S INPUT=$$STADIV(.RCVAUTD) ; Division filter "RTN","RCDPEMAP",11,0) Q:'INPUT ; '^' or timeout "RTN","RCDPEMAP",12,0) S $P(INPUT,"^",2)=$$DTRNG(0) ; Start Date|End date "RTN","RCDPEMAP",13,0) Q:'$P(INPUT,"^",2) ; '^' or timeout "RTN","RCDPEMAP",14,0) S $P(INPUT,"^",3)=$$RTYPE^RCDPEU1("") ; M/P/T filter "RTN","RCDPEMAP",15,0) Q:$P(INPUT,"^",3)<0 ; '^' or timeout "RTN","RCDPEMAP",16,0) S RCPAR("SELC")=$$PAYRNG^RCDPEU1() ; Selected or Range of Payers "RTN","RCDPEMAP",17,0) Q:RCPAR("SELC")=-1 ; '^' or timeout "RTN","RCDPEMAP",18,0) S $P(INPUT,"^",4)=RCPAR("SELC") "RTN","RCDPEMAP",19,0) ; "RTN","RCDPEMAP",20,0) I RCPAR("SELC")'="A" D Q:XX=-1 ; Since we don't want all payers "RTN","RCDPEMAP",21,0) . S RCPAR("TYPE")=$P(INPUT,"^",3) ; prompt for payers we do want "RTN","RCDPEMAP",22,0) . S RCPAR("FILE")=344.4 "RTN","RCDPEMAP",23,0) . S RCPAR("DICA")="Select Insurance Company NAME: " "RTN","RCDPEMAP",24,0) . S XX=$$SELPAY^RCDPEU1(.RCPAR) "RTN","RCDPEMAP",25,0) ; "RTN","RCDPEMAP",26,0) S $P(INPUT,"^",5)=$$SELUSER() ; Selected or All users filter "RTN","RCDPEMAP",27,0) Q:$P(INPUT,"^",5)<0 ; '^' or timeout "RTN","RCDPEMAP",28,0) ; "RTN","RCDPEMAP",29,0) I $P(INPUT,"^",5)=2 D Q:XX=-1 ; Prompt for selected users "RTN","RCDPEMAP",30,0) . S XX=$$SELUSER2() "RTN","RCDPEMAP",31,0) ; "RTN","RCDPEMAP",32,0) S $P(INPUT,"^",6)=$$SECSORT() ; Secondary Sort "RTN","RCDPEMAP",33,0) Q:$P(INPUT,"^",6)<0 ; '^' or timeout "RTN","RCDPEMAP",34,0) S $P(INPUT,"^",7)=$$ASKLM^RCDPEARL ; Ask to Display in Listman Template "RTN","RCDPEMAP",35,0) Q:$P(INPUT,"^",7)<0 ; '^' or timeout "RTN","RCDPEMAP",36,0) I $P(INPUT,"^",7)=1 D Q ; Compile data and call listman to display "RTN","RCDPEMAP",37,0) . D LMOUT(INPUT,.RCVAUTD,.IO) "RTN","RCDPEMAP",38,0) S $P(INPUT,"^",8)=$$EXCEL() ; Ask to output to Excel "RTN","RCDPEMAP",39,0) Q:$P(INPUT,"^",8)=-1 ; '^' or timeout "RTN","RCDPEMAP",40,0) D:$P(INPUT,"^",8)=1 INFO^RCDPEM6 ; Display capture information for Excel "RTN","RCDPEMAP",41,0) S $P(INPUT,"^",9)=$$DEVICE($P(INPUT,"^",8),.IO) ; Ask output device "RTN","RCDPEMAP",42,0) Q:'$P(INPUT,"^",9) "RTN","RCDPEMAP",43,0) ; "RTN","RCDPEMAP",44,0) ; Option to queue "RTN","RCDPEMAP",45,0) I $D(IO("Q")) D Q "RTN","RCDPEMAP",46,0) . N JOB S JOB=$J "RTN","RCDPEMAP",47,0) . N ZTDESC,ZTRTN,ZTSAVE,ZTSK "RTN","RCDPEMAP",48,0) . S ZTRTN="REPORT^RCDPEMAP(INPUT,.RCVAUTD,.IO,JOB)" "RTN","RCDPEMAP",49,0) . S ZTDESC="EEOBS MARKED FOR AUTO-POST AUDIT REPORT" "RTN","RCDPEMAP",50,0) . M RCPYRSEL=^TMP("RCSELPAY",$J) "RTN","RCDPEMAP",51,0) . S ZTSAVE("RC*")="",ZTSAVE("VAUTD")="",ZTSAVE("IO*")="" "RTN","RCDPEMAP",52,0) . S ZTSAVE("INPUT")="",ZTSAVE("JOB")="" "RTN","RCDPEMAP",53,0) . S ZTSAVE("^TMP(""RCDPEU1"",$J,")="" "RTN","RCDPEMAP",54,0) . D ^%ZTLOAD "RTN","RCDPEMAP",55,0) . W !!,$S($D(ZTSK):"Task number "_ZTSK_" was queued.",1:"Unable to queue this task.") "RTN","RCDPEMAP",56,0) . K ZTSK,IO("Q") "RTN","RCDPEMAP",57,0) . D HOME^%ZIS "RTN","RCDPEMAP",58,0) ; "RTN","RCDPEMAP",59,0) D REPORT(INPUT,.RCVAUTD,.IO) ; Compile and Display Report data "RTN","RCDPEMAP",60,0) Q "RTN","RCDPEMAP",61,0) ; "RTN","RCDPEMAP",62,0) LMOUT(INPUT,RCVAUTD,IO) ; Output report to Listman "RTN","RCDPEMAP",63,0) ; Input: INPUT - See REPORT for a complete description "RTN","RCDPEMAP",64,0) ; RCVAUTD - Array of selected Divisions "RTN","RCDPEMAP",65,0) ; Only passed if A1=2 "RTN","RCDPEMAP",66,0) ; Output: ^TMP("RCDPE_MAP",$J,CTR)=Line - Array of display lines (no headers) "RTN","RCDPEMAP",67,0) ; for output to Listman "RTN","RCDPEMAP",68,0) N HDR,RCTEMP "RTN","RCDPEMAP",69,0) S $P(INPUT,"^",10)=0 ; Initial listman line counter "RTN","RCDPEMAP",70,0) D REPORT(INPUT,.RCVAUTD,.IO) ; Get the lines to be displayed "RTN","RCDPEMAP",71,0) S HDR("TITLE")="EEOBs MARKED FOR AP AUDIT" "RTN","RCDPEMAP",72,0) S HDR(1)=$$HDRLN2^RCDPEMA1(INPUT) "RTN","RCDPEMAP",73,0) S HDR(2)=$$HDRLN3^RCDPEMA1(INPUT) "RTN","RCDPEMAP",74,0) S HDR(3)=$$HDRLN4^RCDPEMA1(INPUT) "RTN","RCDPEMAP",75,0) S HDR(4)="ERA # Claim # Trace #" "RTN","RCDPEMAP",76,0) S RCTEMP="RCDPE EEOB MARKED FOR AP AUDIT" "RTN","RCDPEMAP",77,0) D LMRPT^RCDPEARL(.HDR,$NA(^TMP("RCDPE_MAP",$J)),RCTEMP) ; Generate ListMan display "RTN","RCDPEMAP",78,0) ; "RTN","RCDPEMAP",79,0) D ^%ZISC ; Close the device "RTN","RCDPEMAP",80,0) K ^TMP("RCDPE_MAP",$J),^TMP($J,"RCDPE_MAP") "RTN","RCDPEMAP",81,0) K ^TMP("RCSELPAY",$J),^TMP($J,"SELPAYER"),^TMP($J,"SELUSER") "RTN","RCDPEMAP",82,0) Q "RTN","RCDPEMAP",83,0) ; "RTN","RCDPEMAP",84,0) STADIV(RCVAUTD) ; Division/Station Filter "RTN","RCDPEMAP",85,0) ; Input: None "RTN","RCDPEMAP",86,0) ; Output: RCVAUTD - Array of selected divisions, if 1 is returned "RTN","RCDPEMAP",87,0) ; Returns: 0 - User up-arrowed or timed out "RTN","RCDPEMAP",88,0) ; 1 - All divisions selected "RTN","RCDPEMAP",89,0) ; 2 - Selected Divisions "RTN","RCDPEMAP",90,0) N DIR,DIROUT,DIRUT,DTOUT,DUOUT,VAUTD,X,Y "RTN","RCDPEMAP",91,0) D DIVISION^VAUTOMA ; IA #664 allows this "RTN","RCDPEMAP",92,0) Q:Y<0 0 ; User up-arrowed or timed out "RTN","RCDPEMAP",93,0) Q:VAUTD=1 1 ; All divisions selected "RTN","RCDPEMAP",94,0) M RCVAUTD=VAUTD ; Save selected divisions (if any) "RTN","RCDPEMAP",95,0) Q 2 "RTN","RCDPEMAP",96,0) ; "RTN","RCDPEMAP",97,0) SELUSER() ; Ask the user if they only want to all users or only selected ones "RTN","RCDPEMAP",98,0) ; Input: None "RTN","RCDPEMAP",99,0) ; Returns: 0 - User up-arrowed or timed out "RTN","RCDPEMAP",100,0) ; 1 - Show all users "RTN","RCDPEMAP",101,0) ; 2 - Show selected user "RTN","RCDPEMAP",102,0) N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y "RTN","RCDPEMAP",103,0) S DIR("A")="Run Report for (S)pecific or (A)ll Users: " "RTN","RCDPEMAP",104,0) S DIR(0)="SA^S:Specific;A:All" "RTN","RCDPEMAP",105,0) S DIR("?",1)="Enter 'A' to show EEOBs marked by any user." "RTN","RCDPEMAP",106,0) S DIR("?")="Enter 'S' to show EEOBs marked by specific user(s)." "RTN","RCDPEMAP",107,0) S DIR("B")="A" "RTN","RCDPEMAP",108,0) D ^DIR "RTN","RCDPEMAP",109,0) I $D(DTOUT)!$D(DUOUT)!(Y="") Q -1 "RTN","RCDPEMAP",110,0) Q:Y="A" 1 "RTN","RCDPEMAP",111,0) Q 2 "RTN","RCDPEMAP",112,0) ; "RTN","RCDPEMAP",113,0) SELUSER2(PARAM) ; Allows the user to enter the selected users to filter by "RTN","RCDPEMAP",114,0) ; Input: None "RTN","RCDPEMAP",115,0) ; Output: ^TMP($J,"SELUSER",IEN)="" Where IEN - IEN for file 200 "RTN","RCDPEMAP",116,0) ; Returns: 1 - Success, -1 - Abort "RTN","RCDPEMAP",117,0) N RCA,RET,RETURN,QUIT "RTN","RCDPEMAP",118,0) K ^TMP($J,"SELUSER") "RTN","RCDPEMAP",119,0) S QUIT=0,RETURN=1 "RTN","RCDPEMAP",120,0) F D Q:QUIT "RTN","RCDPEMAP",121,0) . S RET=$$ASKUSER() "RTN","RCDPEMAP",122,0) . I RET=-1 S RETURN=-1,QUIT=1 Q "RTN","RCDPEMAP",123,0) . I RET=0 D "RTN","RCDPEMAP",124,0) . . I $D(^TMP($J,"SELUSER")) S QUIT=1 "RTN","RCDPEMAP",125,0) . . E D "RTN","RCDPEMAP",126,0) . . . W !!,"You must select at least one user",*7,! "RTN","RCDPEMAP",127,0) I RETURN=-1 K ^TMP($J,"SELUSER") Q -1 "RTN","RCDPEMAP",128,0) S RETURN=$S($D(^TMP($J,"SELUSER")):1,1:-1) "RTN","RCDPEMAP",129,0) Q RETURN "RTN","RCDPEMAP",130,0) ; "RTN","RCDPEMAP",131,0) ASKUSER() ; Prompt for a User from file 200 "RTN","RCDPEMAP",132,0) ; Input: None "RTN","RCDPEMAP",133,0) ; Output: ^TMP($J,"SELUSER",IEN)="" - Selected User "RTN","RCDPEMAP",134,0) ; Returns: 1 - User selected "RTN","RCDPEMAP",135,0) ; 0 - No User selected "RTN","RCDPEMAP",136,0) ; -1 - user typed '^' or timed out "RTN","RCDPEMAP",137,0) ; "RTN","RCDPEMAP",138,0) N DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y "RTN","RCDPEMAP",139,0) S RETURN=1 "RTN","RCDPEMAP",140,0) ; "RTN","RCDPEMAP",141,0) S DIC=200,DIC(0)="QEA" "RTN","RCDPEMAP",142,0) S DIC("A")="Select User: " "RTN","RCDPEMAP",143,0) S DIC("S")="I '$D(^TMP($J,""SELUSER"",Y))" "RTN","RCDPEMAP",144,0) D ^DIC "RTN","RCDPEMAP",145,0) I $D(DTOUT)!$D(DUOUT) Q -1 "RTN","RCDPEMAP",146,0) I Y=-1 Q 0 "RTN","RCDPEMAP",147,0) S ^TMP($J,"SELUSER",+Y)="" "RTN","RCDPEMAP",148,0) Q 1 "RTN","RCDPEMAP",149,0) ; "RTN","RCDPEMAP",150,0) SECSORT() ; Ask the user if they want the secondary sort by User or Payer Name "RTN","RCDPEMAP",151,0) ; Input: None "RTN","RCDPEMAP",152,0) ; Returns: 0 - User up-arrowed or timed out "RTN","RCDPEMAP",153,0) ; 1 - Sort by User "RTN","RCDPEMAP",154,0) ; 2 - Sort by Payer Name "RTN","RCDPEMAP",155,0) N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y "RTN","RCDPEMAP",156,0) S DIR("A")="Sort by Insurance Company (N)ame or (U)ser: " "RTN","RCDPEMAP",157,0) S DIR(0)="SA^N:Name;U:User" "RTN","RCDPEMAP",158,0) S DIR("?",1)="Enter 'N' to sort by Payer Name." "RTN","RCDPEMAP",159,0) S DIR("?")="Enter 'U' to sort by user." "RTN","RCDPEMAP",160,0) S DIR("B")="N" "RTN","RCDPEMAP",161,0) D ^DIR "RTN","RCDPEMAP",162,0) I $D(DTOUT)!$D(DUOUT)!(Y="") Q -1 "RTN","RCDPEMAP",163,0) Q:Y="U" 1 "RTN","RCDPEMAP",164,0) Q 2 "RTN","RCDPEMAP",165,0) ; "RTN","RCDPEMAP",166,0) DTRNG(WHICH) ; Allows the user to select the Auto-Post OR ERA Received "RTN","RCDPEMAP",167,0) ; date range to be used "RTN","RCDPEMAP",168,0) ; Input: WHICH - 0 - Auto-Post Date Range "RTN","RCDPEMAP",169,0) ; 1 - ERA Date Received Date Range "RTN","RCDPEMAP",170,0) ; Returns: 0 - User up-arrowed or timed out, 1 otherwise "RTN","RCDPEMAP",171,0) ; A1^A2 - Where: "RTN","RCDPEMAP",172,0) ; A1 - Aut-Post Start Date "RTN","RCDPEMAP",173,0) ; A2 - Auto-Post End Date "RTN","RCDPEMAP",174,0) N DIR,DIROUT,DIRUT,DTOUT,DUOUT,RANGE,START,X,XX,Y "RTN","RCDPEMAP",175,0) S DIR(0)="DA^:"_DT_":APE" "RTN","RCDPEMAP",176,0) S DIR("A")="Start Date: " "RTN","RCDPEMAP",177,0) S DIR("?")="Enter the earliest Auto-Post date" "RTN","RCDPEMAP",178,0) D ^DIR "RTN","RCDPEMAP",179,0) Q:$D(DTOUT)!$D(DUOUT)!(Y="") 0 "RTN","RCDPEMAP",180,0) S START=Y "RTN","RCDPEMAP",181,0) ENDDT ; Prompt for end date "RTN","RCDPEMAP",182,0) K DIR "RTN","RCDPEMAP",183,0) S DIR("B")=Y(0) "RTN","RCDPEMAP",184,0) S DIR(0)="DA^"_START_":"_DT_":APE" "RTN","RCDPEMAP",185,0) S DIR("A")="End Date: " "RTN","RCDPEMAP",186,0) S DIR("?")="Enter the latest Auto-Post date" "RTN","RCDPEMAP",187,0) D ^DIR "RTN","RCDPEMAP",188,0) Q:$D(DTOUT)!$D(DUOUT)!(Y="") 0 "RTN","RCDPEMAP",189,0) I Y(DTEND) "RTN","RCDPEMAP",271,0) . S CURDT=$O(^RCY(344.4,"F",CURDT)) "RTN","RCDPEMAP",272,0) . Q:'CURDT "RTN","RCDPEMAP",273,0) . Q:CURDT>(DTEND) "RTN","RCDPEMAP",274,0) . S IEN3444=0 "RTN","RCDPEMAP",275,0) . F D Q:'IEN3444 "RTN","RCDPEMAP",276,0) . . S IEN3444=$O(^RCY(344.4,"F",CURDT,IEN3444)) "RTN","RCDPEMAP",277,0) . . Q:'IEN3444 "RTN","RCDPEMAP",278,0) . . I DIVFLT'=1 Q:'$$CHKDIV^RCDPEDAR(IEN3444,1,.RCVAUTD) ; Not a selected Division "RTN","RCDPEMAP",279,0) . . S PAYER=$$GET1^DIQ(344.4,IEN3444,.06,"I") ; Payment From field "RTN","RCDPEMAP",280,0) . . S TIN=$$GET1^DIQ(344.4,IEN3444,.03,"I") ; Insurance Co Id "RTN","RCDPEMAP",281,0) . . S PAYERU=$$UP^XLFSTR(PAYER) "RTN","RCDPEMAP",282,0) . . S PAYER=TIN_"/"_$E(PAYER,1,70-$L(TIN)) "RTN","RCDPEMAP",283,0) . . S XX=1 "RTN","RCDPEMAP",284,0) . . I RCPAYS'="A" D Q:'XX "RTN","RCDPEMAP",285,0) . . . S XX=$$ISSEL^RCDPEU1(344.4,IEN3444) ; Check if payer was selected "RTN","RCDPEMAP",286,0) . . E I RCTYPE'="A" D Q:'XX ; If all of a give type of payer selected "RTN","RCDPEMAP",287,0) . . . S XX=$$ISTYPE^RCDPEU1(344.4,IEN3444,RCTYPE) ; Check that payer matches type "RTN","RCDPEMAP",288,0) . . S IEN34441="" "RTN","RCDPEMAP",289,0) . . F D Q:IEN34441="" "RTN","RCDPEMAP",290,0) . . . S IEN34441=$O(^RCY(344.4,"F",CURDT,IEN3444,IEN34441)) "RTN","RCDPEMAP",291,0) . . . Q:IEN34441="" "RTN","RCDPEMAP",292,0) . . . S IENS=IEN34441_","_IEN3444_"," "RTN","RCDPEMAP",293,0) . . . S UIEN=$$GET1^DIQ(344.41,IENS,6.01,"I") ; ERA Detail line Marked Auto-Post User "RTN","RCDPEMAP",294,0) . . . Q:UIEN="" ; Not marked for Auto-Post "RTN","RCDPEMAP",295,0) . . . S USER=$$GET1^DIQ(200,UIEN_",",.01,"E") "RTN","RCDPEMAP",296,0) . . . S USERU=$$UP^XLFSTR(USER) "RTN","RCDPEMAP",297,0) . . . I USERF'=1,'$D(^TMP($J,"SELUSER",UIEN)) Q ; Not a selected User "RTN","RCDPEMAP",298,0) . . . S SVAL=$S(SORT=2:PAYERU,1:USERU) ; Get the sort value "RTN","RCDPEMAP",299,0) . . . S XX=PAYER_"^"_USER "RTN","RCDPEMAP",300,0) . . . S $P(XX,"^",3)=$$GET1^DIQ(344.4,IEN3444_",",.01,"E")_"."_IEN34441 ; ERA#_"."_SEQ "RTN","RCDPEMAP",301,0) . . . S YY=$$GET1^DIQ(344.41,IENS,.02,"I") ; IEN for 361.1 "RTN","RCDPEMAP",302,0) . . . S ZZ=$$GET1^DIQ(361.1,YY_",",.01,"I") ; IEN for 399/430 "RTN","RCDPEMAP",303,0) . . . S ZZ=$$GET1^DIQ(430,ZZ_",",.01,"E") ; Claim # "RTN","RCDPEMAP",304,0) . . . S ZZ=$TR(ZZ,"-","") "RTN","RCDPEMAP",305,0) . . . S $P(XX,"^",4)=ZZ "RTN","RCDPEMAP",306,0) . . . S $P(XX,"^",5)=$$GET1^DIQ(361.1,YY_",",.07,"E") ; Trace # "RTN","RCDPEMAP",307,0) . . . ; "RTN","RCDPEMAP",308,0) . . . ; Found one that was marked for auto-post "RTN","RCDPEMAP",309,0) . . . S ^TMP($J,"RCDPE_MAP","SEL",CURDT)=$$FMTE^XLFDT(CURDT,"2ZD") "RTN","RCDPEMAP",310,0) . . . S ^TMP($J,"RCDPE_MAP","SEL",CURDT,SVAL)=$S(SORT=2:PAYER,1:USER) "RTN","RCDPEMAP",311,0) . . . S ^TMP($J,"RCDPE_MAP","SEL",CURDT,SVAL,IEN3444,IEN34441)=XX "RTN","RCDPEMAP",312,0) ; "RTN","RCDPEMAP",313,0) D RPTOUT^RCDPEMA1(INPUT) ; Output the report "RTN","RCDPEMAP",314,0) ; "RTN","RCDPEMAP",315,0) ; Quit if Listman - clean up of ^TMP & device is handled in LMOUT^RCDPELAR "RTN","RCDPEMAP",316,0) Q:$P(INPUT,"^",7)=1 "RTN","RCDPEMAP",317,0) ; "RTN","RCDPEMAP",318,0) ; Close device "RTN","RCDPEMAP",319,0) I '$D(ZTQUEUED) D ^%ZISC "RTN","RCDPEMAP",320,0) I $D(ZTQUEUED) S ZTREQ="@" "RTN","RCDPEMAP",321,0) K ^TMP("RCDPE_MAP",$J),^TMP($J,"RCDPE_MAP") "RTN","RCDPEMAP",322,0) K ^TMP("RCSELPAY",$J),^TMP($J,"SELPAYER"),^TMP($J,"SELUSER") "RTN","RCDPEMAP",323,0) K ^TMP("RCDPEU1",$J) "RTN","RCDPEMAP",324,0) K ZTQUEUED "RTN","RCDPEMAP",325,0) Q "RTN","RCDPEMAP",326,0) ; "RTN","RCDPEMAP",327,0) ASKSTOP() ;EP from RCDPEMA1 "RTN","RCDPEMAP",328,0) ; Ask to continue "RTN","RCDPEMAP",329,0) ; Input: IOST - Device Type "RTN","RCDPEMAP",330,0) ; Returns: 1 - User wants to quit, 0 otherwise "RTN","RCDPEMAP",331,0) N DIR,DIROUT,DIRUT,DTOUT,DUOUT "RTN","RCDPEMAP",332,0) Q:$E(IOST,1,2)'["C-" 0 ; Not a terminal "RTN","RCDPEMAP",333,0) S DIR(0)="E" "RTN","RCDPEMAP",334,0) W ! D ^DIR "RTN","RCDPEMAP",335,0) I ($D(DIRUT))!($D(DUOUT)) Q 1 "RTN","RCDPEMAP",336,0) Q 0 "RTN","RCDPEMAP",337,0) ; "RTN","RCDPENR3") 0^13^B210652613 "RTN","RCDPENR3",1,0) RCDPENR3 ;ALB/SAB - EPay National Reports - ERA/EFT Trending Report, part 2 ;20 Aug 2018 13:01:41 "RTN","RCDPENR3",2,0) ;;4.5;Accounts Receivable;**304,321,326,332**;Mar 20, 1995;Build 40 "RTN","RCDPENR3",3,0) ;;Per VA Directive 6402, this routine should not be modified. "RTN","RCDPENR3",4,0) ; "RTN","RCDPENR3",5,0) ;Read ^DGCR(399) via Private IA 3820 "RTN","RCDPENR3",6,0) ;Read ^DG(40.8) via Controlled IA 417 "RTN","RCDPENR3",7,0) ;Read ^IBM(361.1) via Private IA 4051 "RTN","RCDPENR3",8,0) ;Use DIV^IBJDF2 via Private IA 3130 "RTN","RCDPENR3",9,0) ; "RTN","RCDPENR3",10,0) Q "RTN","RCDPENR3",11,0) ; "RTN","RCDPENR3",12,0) ; "RTN","RCDPENR3",13,0) ;Generate the needed statistics for the report "RTN","RCDPENR3",14,0) COMPILE ; "RTN","RCDPENR3",15,0) ; "RTN","RCDPENR3",16,0) ;RCERATYP values 1="ERA/EFT" 2="ERA/PAPER CHECK" 3="PAPER EOB/EFT" "RTN","RCDPENR3",17,0) ; needed for the correct report sort order "RTN","RCDPENR3",18,0) N I,RCINSTIN,RCERATYP,RCCLAIM,RCDATA,RCDAYS,RCEFTPD,RCEPDT,RCERAIEN,RCERANUM,RCEFTIEN ; Looping variable "RTN","RCDPENR3",19,0) N RCGPDATA,RCGPCT,RCGPBILL,RCGPPD,RCGPBECT,RCGPBEDY,RCGPEECT,RCGPEEDY,RCGPEPCT,RCGPEPDY,RCGPBPCT,RCGPBPDY,RCGPECT,RCGPENM,RCGPFCT,RCGPFPD ; Grand Total W/Payment method variables "RTN","RCDPENR3",20,0) N RCPPDATA,RCPPCT,RCPPBILL,RCPPPD,RCPPBECT,RCPPBEDY,RCPPEECT,RCPPEEDY,RCPPEPCT,RCPPEPDY,RCPPBPCT,RCPPBPDY,RCPPECT,RCPPENM,RCPPFCT,RCPPFPD ; Payer W/Payment method variables "RTN","RCDPENR3",21,0) ; "RTN","RCDPENR3",22,0) ;Initialize all valid ERA/EFT combinations to report on. "RTN","RCDPENR3",23,0) ; init grand total "RTN","RCDPENR3",24,0) F I=1:1:3 I '$D(^TMP("RCDPENR2",$J,"GTOT",I)) S ^TMP("RCDPENR2",$J,"GTOT",I)=0 "RTN","RCDPENR3",25,0) ; "RTN","RCDPENR3",26,0) ; init insurance grand totals "RTN","RCDPENR3",27,0) S RCINSTIN="" "RTN","RCDPENR3",28,0) F S RCINSTIN=$O(^TMP("RCDPENR2",$J,"PAYER",RCINSTIN)) Q:RCINSTIN="" D "RTN","RCDPENR3",29,0) . F I=1:1:3 I '$D(^TMP("RCDPENR2",$J,"PAYER",RCINSTIN,I)) S ^TMP("RCDPENR2",$J,"PAYER",RCINSTIN,I)=0 "RTN","RCDPENR3",30,0) ; "RTN","RCDPENR3",31,0) ; Compile results "RTN","RCDPENR3",32,0) S RCINSTIN="" "RTN","RCDPENR3",33,0) F S RCINSTIN=$O(^TMP("RCDPENR2",$J,"MAIN",RCINSTIN)) Q:RCINSTIN="" D "RTN","RCDPENR3",34,0) . S RCERATYP="" "RTN","RCDPENR3",35,0) . F S RCERATYP=$O(^TMP("RCDPENR2",$J,"MAIN",RCINSTIN,RCERATYP)) Q:RCERATYP="" D "RTN","RCDPENR3",36,0) . . S RCCLAIM="" "RTN","RCDPENR3",37,0) . . F S RCCLAIM=$O(^TMP("RCDPENR2",$J,"MAIN",RCINSTIN,RCERATYP,RCCLAIM)) Q:RCCLAIM="" D "RTN","RCDPENR3",38,0) . . . S RCDATA=$G(^TMP("RCDPENR2",$J,"MAIN",RCINSTIN,RCERATYP,RCCLAIM)) "RTN","RCDPENR3",39,0) . . . Q:RCDATA="" "RTN","RCDPENR3",40,0) . . . ; "RTN","RCDPENR3",41,0) . . . ; Extract the Grand Total by EFT/ERA type "RTN","RCDPENR3",42,0) . . . S RCGPDATA=$G(^TMP("RCDPENR2",$J,"GTOT",RCERATYP)) "RTN","RCDPENR3",43,0) . . . S RCGPCT=$P(RCGPDATA,U) "RTN","RCDPENR3",44,0) . . . S RCGPBILL=$P(RCGPDATA,U,2) "RTN","RCDPENR3",45,0) . . . S RCGPPD=$P(RCGPDATA,U,3) "RTN","RCDPENR3",46,0) . . . S RCGPBECT=$P(RCGPDATA,U,4) "RTN","RCDPENR3",47,0) . . . S RCGPBEDY=$P(RCGPDATA,U,5) "RTN","RCDPENR3",48,0) . . . S RCGPEECT=$P(RCGPDATA,U,6) "RTN","RCDPENR3",49,0) . . . S RCGPEEDY=$P(RCGPDATA,U,7) "RTN","RCDPENR3",50,0) . . . S RCGPEPCT=$P(RCGPDATA,U,8) "RTN","RCDPENR3",51,0) . . . S RCGPEPDY=$P(RCGPDATA,U,9) "RTN","RCDPENR3",52,0) . . . S RCGPBPCT=$P(RCGPDATA,U,10) "RTN","RCDPENR3",53,0) . . . S RCGPBPDY=$P(RCGPDATA,U,11) "RTN","RCDPENR3",54,0) . . . S RCGPECT=$P(RCGPDATA,U,12) "RTN","RCDPENR3",55,0) . . . S RCGPENM=$P(RCGPDATA,U,13) "RTN","RCDPENR3",56,0) . . . S RCGPFCT=$P(RCGPDATA,U,14) "RTN","RCDPENR3",57,0) . . . S RCGPFPD=$P(RCGPDATA,U,15) "RTN","RCDPENR3",58,0) . . . ; "RTN","RCDPENR3",59,0) . . . ; Extract the Payer specific information by EFT/ERA type "RTN","RCDPENR3",60,0) . . . S RCPPDATA=$G(^TMP("RCDPENR2",$J,"PAYER",RCINSTIN,RCERATYP)) "RTN","RCDPENR3",61,0) . . . S RCPPCT=$P(RCPPDATA,U) "RTN","RCDPENR3",62,0) . . . S RCPPBILL=$P(RCPPDATA,U,2) "RTN","RCDPENR3",63,0) . . . S RCPPPD=$P(RCPPDATA,U,3) "RTN","RCDPENR3",64,0) . . . S RCPPBECT=$P(RCPPDATA,U,4) "RTN","RCDPENR3",65,0) . . . S RCPPBEDY=$P(RCPPDATA,U,5) "RTN","RCDPENR3",66,0) . . . S RCPPEECT=$P(RCPPDATA,U,6) "RTN","RCDPENR3",67,0) . . . S RCPPEEDY=$P(RCPPDATA,U,7) "RTN","RCDPENR3",68,0) . . . S RCPPEPCT=$P(RCPPDATA,U,8) "RTN","RCDPENR3",69,0) . . . S RCPPEPDY=$P(RCPPDATA,U,9) "RTN","RCDPENR3",70,0) . . . S RCPPBPCT=$P(RCPPDATA,U,10) "RTN","RCDPENR3",71,0) . . . S RCPPBPDY=$P(RCPPDATA,U,11) "RTN","RCDPENR3",72,0) . . . S RCPPECT=$P(RCPPDATA,U,12) "RTN","RCDPENR3",73,0) . . . S RCPPENM=$P(RCPPDATA,U,13) "RTN","RCDPENR3",74,0) . . . S RCPPFCT=$P(RCPPDATA,U,14) "RTN","RCDPENR3",75,0) . . . S RCPPFPD=$P(RCPPDATA,U,15) "RTN","RCDPENR3",76,0) . . . ; "RTN","RCDPENR3",77,0) . . . ; Total counts - Grand/Payment Method "RTN","RCDPENR3",78,0) . . . S RCGPCT=RCGPCT+1 "RTN","RCDPENR3",79,0) . . . S RCGPBILL=RCGPBILL+$P(RCDATA,U,6) "RTN","RCDPENR3",80,0) . . . S RCGPPD=RCGPPD+$P(RCDATA,U,7) "RTN","RCDPENR3",81,0) . . . ; "RTN","RCDPENR3",82,0) . . . ; Total counts - Payer/Payment method "RTN","RCDPENR3",83,0) . . . S RCPPCT=RCPPCT+1 "RTN","RCDPENR3",84,0) . . . S RCPPBILL=RCPPBILL+$P(RCDATA,U,6) "RTN","RCDPENR3",85,0) . . . S RCPPPD=RCPPPD+$P(RCDATA,U,7) "RTN","RCDPENR3",86,0) . . . ; "RTN","RCDPENR3",87,0) . . . ; Billed to ERA received "RTN","RCDPENR3",88,0) . . . I $P(RCDATA,U,8),$P(RCDATA,U,9) D "RTN","RCDPENR3",89,0) . . . . S RCGPBECT=RCGPBECT+1 "RTN","RCDPENR3",90,0) . . . . S RCPPBECT=RCPPBECT+1 "RTN","RCDPENR3",91,0) . . . . S RCDAYS=$$FMDIFF^XLFDT($P(RCDATA,U,9),$P(RCDATA,U,8),1) "RTN","RCDPENR3",92,0) . . . . S RCGPBEDY=RCGPBEDY+RCDAYS "RTN","RCDPENR3",93,0) . . . . S RCPPBEDY=RCPPBEDY+RCDAYS "RTN","RCDPENR3",94,0) . . . ; "RTN","RCDPENR3",95,0) . . . ; ERA to EFT received "RTN","RCDPENR3",96,0) . . . I $P(RCDATA,U,10),$P(RCDATA,U,9) D "RTN","RCDPENR3",97,0) . . . . S RCGPEECT=RCGPEECT+1 "RTN","RCDPENR3",98,0) . . . . S RCPPEECT=RCPPEECT+1 "RTN","RCDPENR3",99,0) . . . . S RCDAYS=$$FMDIFF^XLFDT($P(RCDATA,U,10),$P(RCDATA,U,9),1) "RTN","RCDPENR3",100,0) . . . . S RCGPEEDY=RCGPEEDY+RCDAYS "RTN","RCDPENR3",101,0) . . . . S RCPPEEDY=RCPPEEDY+RCDAYS "RTN","RCDPENR3",102,0) . . . ; "RTN","RCDPENR3",103,0) . . . ; ERA and EFT received, and payment Posted "RTN","RCDPENR3",104,0) . . . I $P(RCDATA,U,10),$P(RCDATA,U,9),$P(RCDATA,U,11) D "RTN","RCDPENR3",105,0) . . . . S RCGPEPCT=RCGPEPCT+1 "RTN","RCDPENR3",106,0) . . . . S RCPPEPCT=RCPPEPCT+1 "RTN","RCDPENR3",107,0) . . . . S RCEPDT=$S($P(RCDATA,U,9)>$P(RCDATA,U,10):9,1:10) ;determine which date is later "RTN","RCDPENR3",108,0) . . . . S RCDAYS=$$FMDIFF^XLFDT($P(RCDATA,U,11),$P(RCDATA,U,RCEPDT),1) "RTN","RCDPENR3",109,0) . . . . S RCGPEPDY=RCGPEPDY+RCDAYS "RTN","RCDPENR3",110,0) . . . . S RCPPEPDY=RCPPEPDY+RCDAYS "RTN","RCDPENR3",111,0) . . . ; "RTN","RCDPENR3",112,0) . . . ; Bill to Payment Posted "RTN","RCDPENR3",113,0) . . . I $P(RCDATA,U,8),$P(RCDATA,U,11) D "RTN","RCDPENR3",114,0) . . . . S RCGPBPCT=RCGPBPCT+1 "RTN","RCDPENR3",115,0) . . . . S RCPPBPCT=RCPPBPCT+1 "RTN","RCDPENR3",116,0) . . . . S RCDAYS=$$FMDIFF^XLFDT($P(RCDATA,U,11),$P(RCDATA,U,8),1) "RTN","RCDPENR3",117,0) . . . . S RCGPBPDY=RCGPBPDY+RCDAYS "RTN","RCDPENR3",118,0) . . . . S RCPPBPDY=RCPPBPDY+RCDAYS "RTN","RCDPENR3",119,0) . . . ; "RTN","RCDPENR3",120,0) . . . ; If the ERA hasn't already been counted, add it to the totals "RTN","RCDPENR3",121,0) . . . S RCERAIEN=$P(RCDATA,U,2) "RTN","RCDPENR3",122,0) . . . I RCERAIEN,'$D(^TMP("RCDPENR2",$J,"ERA",RCERAIEN)) D "RTN","RCDPENR3",123,0) . . . . S ^TMP("RCDPENR2",$J,"ERA",RCERAIEN)="" "RTN","RCDPENR3",124,0) . . . . S RCERANUM=$P(RCDATA,U,15) "RTN","RCDPENR3",125,0) . . . . S RCGPECT=RCGPECT+1,RCPPECT=RCPPECT+1 "RTN","RCDPENR3",126,0) . . . . S RCGPENM=RCGPENM+RCERANUM,RCPPENM=RCPPENM+RCERANUM "RTN","RCDPENR3",127,0) . . . ; "RTN","RCDPENR3",128,0) . . . ; If the EFT hasn't already been counted, add it to the totals "RTN","RCDPENR3",129,0) . . . S RCEFTIEN=$P(RCDATA,U,3) "RTN","RCDPENR3",130,0) . . . I (RCEFTIEN),('$D(^TMP("RCDPENR2",$J,"EFT",RCEFTIEN))) D "RTN","RCDPENR3",131,0) . . . . S ^TMP("RCDPENR2",$J,"EFT",RCEFTIEN)="" "RTN","RCDPENR3",132,0) . . . . S RCEFTPD=$P(RCDATA,U,18) "RTN","RCDPENR3",133,0) . . . . S RCGPFCT=RCGPFCT+1,RCPPFCT=RCPPFCT+1 "RTN","RCDPENR3",134,0) . . . . S RCGPFPD=RCGPFPD+RCEFTPD,RCPPFPD=RCPPFPD+RCEFTPD "RTN","RCDPENR3",135,0) . . . ; "RTN","RCDPENR3",136,0) . . . ; Update the payer specific information By Payment Method "RTN","RCDPENR3",137,0) . . . S $P(RCPPDATA,U)=RCPPCT "RTN","RCDPENR3",138,0) . . . S $P(RCPPDATA,U,2)=RCPPBILL "RTN","RCDPENR3",139,0) . . . S $P(RCPPDATA,U,3)=RCPPPD "RTN","RCDPENR3",140,0) . . . S $P(RCPPDATA,U,4)=RCPPBECT "RTN","RCDPENR3",141,0) . . . S $P(RCPPDATA,U,5)=RCPPBEDY "RTN","RCDPENR3",142,0) . . . S $P(RCPPDATA,U,6)=RCPPEECT "RTN","RCDPENR3",143,0) . . . S $P(RCPPDATA,U,7)=RCPPEEDY "RTN","RCDPENR3",144,0) . . . S $P(RCPPDATA,U,8)=RCPPEPCT "RTN","RCDPENR3",145,0) . . . S $P(RCPPDATA,U,9)=RCPPEPDY "RTN","RCDPENR3",146,0) . . . S $P(RCPPDATA,U,10)=RCPPBPCT "RTN","RCDPENR3",147,0) . . . S $P(RCPPDATA,U,11)=RCPPBPDY "RTN","RCDPENR3",148,0) . . . S $P(RCPPDATA,U,12)=RCPPECT "RTN","RCDPENR3",149,0) . . . S $P(RCPPDATA,U,13)=RCPPENM "RTN","RCDPENR3",150,0) . . . S $P(RCPPDATA,U,14)=RCPPFCT "RTN","RCDPENR3",151,0) . . . S $P(RCPPDATA,U,15)=RCPPFPD "RTN","RCDPENR3",152,0) . . . S ^TMP("RCDPENR2",$J,"PAYER",RCINSTIN,RCERATYP)=RCPPDATA "RTN","RCDPENR3",153,0) . . . ; "RTN","RCDPENR3",154,0) . . . ; Update the Grand Total specific information By Payment Method "RTN","RCDPENR3",155,0) . . . S $P(RCGPDATA,U)=RCGPCT "RTN","RCDPENR3",156,0) . . . S $P(RCGPDATA,U,2)=RCGPBILL "RTN","RCDPENR3",157,0) . . . S $P(RCGPDATA,U,3)=RCGPPD "RTN","RCDPENR3",158,0) . . . S $P(RCGPDATA,U,4)=RCGPBECT "RTN","RCDPENR3",159,0) . . . S $P(RCGPDATA,U,5)=RCGPBEDY "RTN","RCDPENR3",160,0) . . . S $P(RCGPDATA,U,6)=RCGPEECT "RTN","RCDPENR3",161,0) . . . S $P(RCGPDATA,U,7)=RCGPEEDY "RTN","RCDPENR3",162,0) . . . S $P(RCGPDATA,U,8)=RCGPEPCT "RTN","RCDPENR3",163,0) . . . S $P(RCGPDATA,U,9)=RCGPEPDY "RTN","RCDPENR3",164,0) . . . S $P(RCGPDATA,U,10)=RCGPBPCT "RTN","RCDPENR3",165,0) . . . S $P(RCGPDATA,U,11)=RCGPBPDY "RTN","RCDPENR3",166,0) . . . S $P(RCGPDATA,U,12)=RCGPECT "RTN","RCDPENR3",167,0) . . . S $P(RCGPDATA,U,13)=RCGPENM "RTN","RCDPENR3",168,0) . . . S $P(RCGPDATA,U,14)=RCGPFCT "RTN","RCDPENR3",169,0) . . . S $P(RCGPDATA,U,15)=RCGPFPD "RTN","RCDPENR3",170,0) . . . S ^TMP("RCDPENR2",$J,"GTOT",RCERATYP)=RCGPDATA "RTN","RCDPENR3",171,0) Q "RTN","RCDPENR3",172,0) ; "RTN","RCDPENR3",173,0) ;Retrieve all necessary information for the EFTs sent during the requested period. "RTN","RCDPENR3",174,0) GETEFT(RCSDATE,RCEDATE,RCRATE) ; "RTN","RCDPENR3",175,0) ;RCSDATE - Start date of extraction "RTN","RCDPENR3",176,0) ;RCEDATE - End date of extraction "RTN","RCDPENR3",177,0) ; "RTN","RCDPENR3",178,0) ;^TMP("RCDPENR2",$J,"MAIN",IEN of Claim/Bill #) = "RTN","RCDPENR3",179,0) ; Where: "RTN","RCDPENR3",180,0) ; Piece Variable "RTN","RCDPENR3",181,0) ; 1 RCBILL - IEN of Bill/Claim # "RTN","RCDPENR3",182,0) ; 2 RCERA - IEN of the ERA the bill was paid on. "RTN","RCDPENR3",183,0) ; 3 RCIEN - IEN of the EFT the money for the bill arrived on "RTN","RCDPENR3",184,0) ; 4 RCEOB - IEN of the EOB within the ERA "RTN","RCDPENR3",185,0) ; 5 RCDOS - Date of Service "RTN","RCDPENR3",186,0) ; 6 RCAMTBL - Amount Billed "RTN","RCDPENR3",187,0) ; 7 RCAMTPD - Amount Paid "RTN","RCDPENR3",188,0) ; 8 RCDTBILL - Date of Bill "RTN","RCDPENR3",189,0) ; 9 RCERARCD - Date ERA received "RTN","RCDPENR3",190,0) ; 10 RCEFTRCD - Date EFT received "RTN","RCDPENR3",191,0) ; 11 RCPOSTED - Date Payment Posted to claim "RTN","RCDPENR3",192,0) ; 12 RCTRACE - ERA Trace number for EOB "RTN","RCDPENR3",193,0) ; 13 RCMETHOD - Method of Payment transmittal "RTN","RCDPENR3",194,0) ; 14 RCTRNTYP - Was payment EFT or Paper Check / Was the ERA Paper or EDI Lockbox "RTN","RCDPENR3",195,0) ; 15 RCERANUM - # EOB'S in ERA "RTN","RCDPENR3",196,0) ; 16 RCDIV - Division of the bill "RTN","RCDPENR3",197,0) ; 17 RCINSTIN - Insurance/Insurance TIN "RTN","RCDPENR3",198,0) ; 18 RCEFTPD - Amount paid as an EFT, not as a check. "RTN","RCDPENR3",199,0) ; "RTN","RCDPENR3",200,0) N OKAY,RCLDATE,RCINS,RCIEN,RCEFTDT,RCERA,RCEFT,RCRCPT,RCPOSTED,RCPAYTYP,RCERADT,RCTRACE,RCERAIDX "RTN","RCDPENR3",201,0) N RCTRLN,RCTRBD,RCERANUM,RCTIN,RCPAYER,RCINSTIN,RCLPIEN,RCDTDATA,RCEOB,RCBILL,RCDIV,RCDOS,RCAMTBL "RTN","RCDPENR3",202,0) N RCDTBILL,RCMETHOD,RCPAPER,RCEFTTYP,RCEFTPD,RCTRNTYP,RCDATA,RCAMTPD,RCEFTRCD,RCERARCD,RCRATETP "RTN","RCDPENR3",203,0) N RCMSTAT,RCESUMDT,RCPSUMDT,ZZPNAME "RTN","RCDPENR3",204,0) ; "RTN","RCDPENR3",205,0) ;Get the EFT Detail information for the report batches sent within the given date range. "RTN","RCDPENR3",206,0) S RCLDATE=RCSDATE-.001 "RTN","RCDPENR3",207,0) F S RCLDATE=$O(^RCY(344.31,"ADR",RCLDATE)) Q:RCLDATE="" Q:RCLDATE>RCEDATE D "RTN","RCDPENR3",208,0) . S RCIEN=0 "RTN","RCDPENR3",209,0) . F S RCIEN=$O(^RCY(344.31,"ADR",RCLDATE,RCIEN)) Q:'RCIEN D "RTN","RCDPENR3",210,0) . . S RCEFTDT=$G(^RCY(344.31,RCIEN,0)) "RTN","RCDPENR3",211,0) . . Q:RCEFTDT="" "RTN","RCDPENR3",212,0) . . I RCPAY="A",RCTYPE'="A" D Q:'OKAY ; PRCA*4.5*326 If all payers included, check by type "RTN","RCDPENR3",213,0) . . . S OKAY=$$ISTYPE^RCDPEU1(344.31,RCIEN,RCTYPE) "RTN","RCDPENR3",214,0) . . ; Check Payer Name "RTN","RCDPENR3",215,0) . . I RCPAY'="A" D Q:'OKAY ; PRCA*4.5*326 "RTN","RCDPENR3",216,0) . . . S OKAY=$$ISSEL^RCDPEU1(344.31,RCIEN) "RTN","RCDPENR3",217,0) . . ; "RTN","RCDPENR3",218,0) . . S RCERA=$P(RCEFTDT,U,10) ; ERA IEN "RTN","RCDPENR3",219,0) . . S RCEFTRCD=$P(RCEFTDT,U,13) "RTN","RCDPENR3",220,0) . . S RCEFT=$P(RCEFTDT,U) "RTN","RCDPENR3",221,0) . . S ZZPNAME=$P(RCEFTDT,U,2) "RTN","RCDPENR3",222,0) . . S RCMSTAT=$P(RCEFTDT,U,8) "RTN","RCDPENR3",223,0) . . S RCRCPT=$P(RCEFTDT,U,9) "RTN","RCDPENR3",224,0) . . S RCEFTPD=$P(RCEFTDT,U,7) "RTN","RCDPENR3",225,0) . . S RCPOSTED=$$GET1^DIQ(344.3,RCEFT_",",.11,"I") "RTN","RCDPENR3",226,0) . . S RCPAYTYP=$$GET1^DIQ(344,RCRCPT_",",.04,"I") "RTN","RCDPENR3",227,0) . . I RCERA D Q "RTN","RCDPENR3",228,0) . . . S RCERADT=$G(^RCY(344.4,RCERA,0)) ; ERA Data extracted "RTN","RCDPENR3",229,0) . . . Q:'RCERADT "RTN","RCDPENR3",230,0) . . . S RCTRACE=$P(RCERADT,U,2) ; Trace # "RTN","RCDPENR3",231,0) . . . S RCTRLN=$L(RCTRACE),RCTRBD=$S(RCTRLN<11:1,1:RCTRLN-9) "RTN","RCDPENR3",232,0) . . . S RCTRACE=$E(RCTRACE,RCTRBD,RCTRLN) ; get the last 10 digits of Trace # "RTN","RCDPENR3",233,0) . . . S RCERARCD=$P($P(RCERADT,U,7),".",1) ;get the date of the ERA "RTN","RCDPENR3",234,0) . . . S RCERANUM=$P(RCERADT,U,11) "RTN","RCDPENR3",235,0) . . . S RCTIN=$P(RCERADT,U,3) "RTN","RCDPENR3",236,0) . . . S RCINS=$P(RCERADT,U,6) "RTN","RCDPENR3",237,0) . . . S RCPAYER=$$GETARPYR^RCDPENR2(RCTIN,ZZPNAME) ; find the AR Payer IEN "RTN","RCDPENR3",238,0) . . . ; Q:'RCPAYER ; Quit if Payer/TIN not found "RTN","RCDPENR3",239,0) . . . ; Q:'$$INSCHK^RCDPENR2(RCPAYER) ; Payer is not in the included list for the report "RTN","RCDPENR3",240,0) . . . S RCINSTIN=RCINS_"/"_RCTIN "RTN","RCDPENR3",241,0) . . . S RCLPIEN=0 "RTN","RCDPENR3",242,0) . . . F S RCLPIEN=$O(^RCY(344.4,RCERA,1,RCLPIEN)) Q:'RCLPIEN D "RTN","RCDPENR3",243,0) . . . . S RCDTDATA=$G(^RCY(344.4,RCERA,1,RCLPIEN,0)) "RTN","RCDPENR3",244,0) . . . . S RCEOB=$P(RCDTDATA,U,2) "RTN","RCDPENR3",245,0) . . . . S RCBILL=$$BILLIEN^RCDPENR1(RCEOB) "RTN","RCDPENR3",246,0) . . . . Q:RCBILL="" ; no billing information "RTN","RCDPENR3",247,0) . . . . Q:$D(^TMP("RCDPENR2",$J,"MAIN",RCBILL)) ;already captured. "RTN","RCDPENR3",248,0) . . . . S RCDIV=$$DIV^IBJDF2(RCBILL) "RTN","RCDPENR3",249,0) . . . . S RCDIV=$$GET1^DIQ(40.8,RCDIV_",",".01","E") "RTN","RCDPENR3",250,0) . . . . ; "RTN","RCDPENR3",251,0) . . . . S RCRATETP=$$GET1^DIQ(399,RCBILL_",",.07,"I") "RTN","RCDPENR3",252,0) . . . . Q:RCRATETP'=RCRATE "RTN","RCDPENR3",253,0) . . . . ; Quit if user specified a specific division and bill is not in that Division "RTN","RCDPENR3",254,0) . . . . I '$D(^TMP("RCDPENR2",$J,"DIVALL"))&'$D(^TMP("RCDPENR2",$J,"DIV",RCDIV)) Q "RTN","RCDPENR3",255,0) . . . . S RCDOS=$$GET1^DIQ(399,RCBILL_",",.03,"I") "RTN","RCDPENR3",256,0) . . . . S RCAMTBL=$$GET1^DIQ(361.1,RCEOB_",",2.04,"I") "RTN","RCDPENR3",257,0) . . . . S RCAMTPD=$$GET1^DIQ(361.1,RCEOB_",",1.01,"I") "RTN","RCDPENR3",258,0) . . . . S RCDTBILL=$$GET1^DIQ(399,RCBILL_",",12,"I") "RTN","RCDPENR3",259,0) . . . . Q:RCDTBILL="" ;cant calculate if date first printed is NULL "RTN","RCDPENR3",260,0) . . . . ; "RTN","RCDPENR3",261,0) . . . . S RCMETHOD=$S($$GET1^DIQ(344,RCERA_",",4.02,"I")="":"MANUAL",1:"AUTOPOST") "RTN","RCDPENR3",262,0) . . . . S RCPAPER=$P($G(^RCY(344.4,RCERA,20)),U,3) ; Paper EOB ERA? "RTN","RCDPENR3",263,0) . . . . ;ERA not a paper ERA, is the EOB a Paper EOB "RTN","RCDPENR3",264,0) . . . . S:'RCPAPER RCPAPER=$S($$GET1^DIQ(361.1,RCEOB_",",.17,"I")=0:"ERA",1:"PAPER") "RTN","RCDPENR3",265,0) . . . . S RCEFTTYP=$S(RCPAYTYP=4:"PAPER",1:"EFT") "RTN","RCDPENR3",266,0) . . . . S RCTRNTYP=RCPAPER_"/"_RCEFTTYP "RTN","RCDPENR3",267,0) . . . . S RCERAIDX=$S(RCTRNTYP="ERA/EFT":1,RCTRNTYP="ERA/PAPER":2,RCTRNTYP="PAPER/EFT":3,1:4) "RTN","RCDPENR3",268,0) . . . . Q:RCERAIDX=4 ;Paper Check Paper EOB not supported "RTN","RCDPENR3",269,0) . . . . S RCDATA=RCBILL_U_RCERA_U_RCIEN_U_RCEOB_U_RCDOS_U_RCAMTBL_U_RCAMTPD_U_RCDTBILL_U_RCERARCD "RTN","RCDPENR3",270,0) . . . . S RCDATA=RCDATA_U_RCEFTRCD_U_RCPOSTED_U_RCTRACE_U_RCMETHOD_U "RTN","RCDPENR3",271,0) . . . . S RCDATA=RCDATA_RCTRNTYP_U_RCERANUM_U_RCDIV_U_RCINSTIN_U_RCEFTPD "RTN","RCDPENR3",272,0) . . . . S ^TMP("RCDPENR2",$J,"MAIN",RCINSTIN,RCERAIDX,RCBILL)=RCDATA "RTN","RCDPENR3",273,0) . . I (RCMSTAT=2),(RCIEN),('$D(^TMP("RCDPENR2",$J,"EFT",RCIEN))) D "RTN","RCDPENR3",274,0) . . . S RCTIN=$P(RCEFTDT,U,3) "RTN","RCDPENR3",275,0) . . . S RCINS=$P(RCEFTDT,U,2) "RTN","RCDPENR3",276,0) . . . S RCPAYER=$$GETARPYR^RCDPENR2(RCTIN,ZZPNAME) ; find the AR Payer IEN "RTN","RCDPENR3",277,0) . . . ; Q:'RCPAYER ; Quit if Payer/TIN not found "RTN","RCDPENR3",278,0) . . . ; Q:'$$INSCHK^RCDPENR2(RCPAYER) ; Payer is not in the included list for the report "RTN","RCDPENR3",279,0) . . . S RCINSTIN=RCINS_"/"_RCTIN "RTN","RCDPENR3",280,0) . . . S RCESUMDT=$G(^TMP("RCDPENR2",$J,"GTOT",3)) "RTN","RCDPENR3",281,0) . . . S RCPSUMDT=$G(^TMP("RCDPENR2",$J,"PAYER",RCINSTIN,3)) "RTN","RCDPENR3",282,0) . . . S $P(RCESUMDT,U,14)=$P(RCESUMDT,U,14)+1 "RTN","RCDPENR3",283,0) . . . S $P(RCPSUMDT,U,14)=$P(RCPSUMDT,U,14)+1 "RTN","RCDPENR3",284,0) . . . S $P(RCESUMDT,U,15)=$P(RCESUMDT,U,15)+RCEFTPD "RTN","RCDPENR3",285,0) . . . S $P(RCPSUMDT,U,15)=$P(RCPSUMDT,U,15)+RCEFTPD "RTN","RCDPENR3",286,0) . . . S ^TMP("RCDPENR2",$J,"GTOT",3)=RCESUMDT "RTN","RCDPENR3",287,0) . . . S ^TMP("RCDPENR2",$J,"PAYER",RCINSTIN,3)=RCPSUMDT "RTN","RCDPENR3",288,0) Q "RTN","RCDPENR3",289,0) ; "RTN","RCDPENR3",290,0) ;Print the Grand Total/Summary data for the EFT/ERA Trending Report "RTN","RCDPENR3",291,0) PRINTGT(RCTITLE,RCDATA,RCDISP,RCERAFLG,RCEXCEL) ;PRCA*4.5*332 - added comments below, 20 August 2018 "RTN","RCDPENR3",292,0) ; Print the Grand Total/Summary data for the EFT/ERA Trending Report "RTN","RCDPENR3",293,0) ; Input: RCTITLE - Name of the report "RTN","RCDPENR3",294,0) ; RCDATA - Line of compiled data being processed "RTN","RCDPENR3",295,0) ; RCDISP - 1 - Display to screen, 0 otherwise "RTN","RCDPENR3",296,0) ; RCERAFLG - 1 if we're in the ERA matched to an EFT section "RTN","RCDPENR3",297,0) ; 0 otherwise "RTN","RCDPENR3",298,0) ; RCEXCEL - 1 output to excel, 0 otherwise "RTN","RCDPENR3",299,0) ; RCSTOP - Initialized to 0 "RTN","RCDPENR3",300,0) ; Output: RCSTOP - User stopped the display of the report "RTN","RCDPENR3",301,0) ; "RTN","RCDPENR3",302,0) ; Undeclared Parameter(s) - RCRPIEN,RCLINE,RCSTOP "RTN","RCDPENR3",303,0) ; RCRPIEN - IEN of the archive file (344.91( "RTN","RCDPENR3",304,0) ; RCLINE - String of '-' to be used as a separator line "RTN","RCDPENR3",305,0) ; RCSUMFLG - 'M' - Main Report "RTN","RCDPENR3",306,0) ; 'G' - Grand totals "RTN","RCDPENR3",307,0) ; 'S' - Summary "RTN","RCDPENR3",308,0) ; "RTN","RCDPENR3",309,0) ;PRCA*4.5*332 comments end "RTN","RCDPENR3",310,0) ; "RTN","RCDPENR3",311,0) N RCCOUNT,RCBILL,RCPAID,RCPCT,RCBECT,RCBEDY,RCAVGBE,RCEECT,RCEEDY "RTN","RCDPENR3",312,0) N RCEPCT,RCEPDY,RCAVGEP,RCBPCT,RCBPDY,RCAVGBP,RCBORDER,RCSCDATA "RTN","RCDPENR3",313,0) N RCC,RCB,RCAVGEE,RCLTXT,I,RCSTRDTA,RCSTRNG,RCDTXT "RTN","RCDPENR3",314,0) ; "RTN","RCDPENR3",315,0) S RCERAFLG=+$G(RCERAFLG),RCDISP=$G(RCDISP) "RTN","RCDPENR3",316,0) I $Y>(IOSL-7),RCDISP D ASK^RCDPEADP(.RCSTOP,0) Q:RCSTOP D HEADER^RCDPENR2 "RTN","RCDPENR3",317,0) ; "RTN","RCDPENR3",318,0) ; Display report type being displayed "RTN","RCDPENR3",319,0) D PRINTHDR^RCDPENR2(RCTITLE) "RTN","RCDPENR3",320,0) ; "RTN","RCDPENR3",321,0) ; Extract data from string and build string for output "RTN","RCDPENR3",322,0) S $P(RCSCDATA,U,1)=+$P(RCDATA,U) "RTN","RCDPENR3",323,0) S RCBILL=+$P(RCDATA,U,2) "RTN","RCDPENR3",324,0) S RCPAID=+$P(RCDATA,U,3) "RTN","RCDPENR3",325,0) S $P(RCSCDATA,U,2)=RCBILL "RTN","RCDPENR3",326,0) S $P(RCSCDATA,U,3)=RCPAID "RTN","RCDPENR3",327,0) S $P(RCSCDATA,U,4)=$S(+RCBILL=0:0,1:RCPAID/RCBILL)*100 ; Convert to percent format "RTN","RCDPENR3",328,0) S RCBECT=+$P(RCDATA,U,4) "RTN","RCDPENR3",329,0) S RCBEDY=+$P(RCDATA,U,5) "RTN","RCDPENR3",330,0) S $P(RCSCDATA,U,6)=$FN($S(+RCBECT=0:0,1:RCBEDY/RCBECT),"",0) "RTN","RCDPENR3",331,0) S RCEECT=+$P(RCDATA,U,6) "RTN","RCDPENR3",332,0) S RCEEDY=+$P(RCDATA,U,7) "RTN","RCDPENR3",333,0) S $P(RCSCDATA,U,7)=$FN($S(+RCEECT=0:0,1:RCEEDY/RCEECT),"",0) "RTN","RCDPENR3",334,0) S RCEPCT=+$P(RCDATA,U,8) "RTN","RCDPENR3",335,0) S RCEPDY=+$P(RCDATA,U,9) "RTN","RCDPENR3",336,0) S $P(RCSCDATA,U,8)=$FN($S(+RCEPCT=0:0,1:RCEPDY/RCEPCT),"",0) "RTN","RCDPENR3",337,0) S RCBPCT=+$P(RCDATA,U,10) "RTN","RCDPENR3",338,0) S RCBPDY=+$P(RCDATA,U,11) "RTN","RCDPENR3",339,0) S $P(RCSCDATA,U,9)=$FN($S(+RCBPCT=0:0,1:RCBPDY/RCBPCT),"",0) "RTN","RCDPENR3",340,0) S $P(RCSCDATA,U,11)=+$P(RCDATA,U,12) "RTN","RCDPENR3",341,0) S $P(RCSCDATA,U,12)=+$P(RCDATA,U,13) "RTN","RCDPENR3",342,0) S $P(RCSCDATA,U,14)=+$P(RCDATA,U,14) "RTN","RCDPENR3",343,0) S $P(RCSCDATA,U,15)=+$P(RCDATA,U,15) "RTN","RCDPENR3",344,0) S $P(RCSCDATA,U,16)=RCPAID-$P(RCDATA,U,15) "RTN","RCDPENR3",345,0) F I=1:1:16 D Q:RCSTOP "RTN","RCDPENR3",346,0) . ; PRC*4.5*332, added (RCSUMFLG'="G") below "RTN","RCDPENR3",347,0) . I (RCSUMFLG'="G"),RCDISP,($Y>(IOSL-4)) D Q:RCSTOP "RTN","RCDPENR3",348,0) . . D ASK^RCDPEADP(.RCSTOP,0) "RTN","RCDPENR3",349,0) . . Q:RCSTOP "RTN","RCDPENR3",350,0) . . D HEADER^RCDPENR2 "RTN","RCDPENR3",351,0) . ;if printing from monthly background job save in file and quit "RTN","RCDPENR3",352,0) . ;Otherwise print to screen "RTN","RCDPENR3",353,0) . S (RCLTXT,RCDTXT)=$P($T(GDTXT+I),";;",2) "RTN","RCDPENR3",354,0) . I RCTITLE["PAPER" D "RTN","RCDPENR3",355,0) . . I (I>5),(I<9) D ; correct display for lines 6,7,8,16 "RTN","RCDPENR3",356,0) . . . I (I=6),RCTITLE["CHECK" Q ;Dont change line 6 if Paper check section "RTN","RCDPENR3",357,0) . . . S RCB="EFT",RCC="CHK" ; Correct display for Paper check section "RTN","RCDPENR3",358,0) . . . I RCTITLE["EOB" S RCB="ERA",RCC="EOB" ;correct display for paper eob "RTN","RCDPENR3",359,0) . . . S RCDTXT=$P(RCLTXT,RCB,1)_RCC_$P(RCLTXT,RCB,2) "RTN","RCDPENR3",360,0) . I 'RCDISP!RCEXCEL D Q "RTN","RCDPENR3",361,0) . . S RCSTRDTA=$P(RCSCDATA,U,I) "RTN","RCDPENR3",362,0) . . ;Format lines: lines 2&3 are amounts, 4 is a percentage, remainder are integers. "RTN","RCDPENR3",363,0) . . S RCSTRNG=RCDTXT_"^"_$S(I=4:$J($P(RCSTRDTA,"."),2)_"%",1:RCSTRDTA) "RTN","RCDPENR3",364,0) . . I 'RCDISP D SAVEDATA^RCDPENR1(RCSTRNG,RCRPIEN) Q "RTN","RCDPENR3",365,0) . .;if printing in an EXCEL format, print "^" delimited and quit "RTN","RCDPENR3",366,0) . . I RCEXCEL W RCSTRNG,! Q "RTN","RCDPENR3",367,0) . ;Output to screen "RTN","RCDPENR3",368,0) . ;currency format "RTN","RCDPENR3",369,0) . I (I=2)!(I=3)!(I=15) W RCDTXT,?65,$J($P(RCSCDATA,U,I),13,2),! Q "RTN","RCDPENR3",370,0) . ; For the line items that are percentages. Not using $J formatting due to rounding errors. "RTN","RCDPENR3",371,0) . I I=4 W RCDTXT,?65,$J($P($P(RCSCDATA,U,I),"."),12),"%",! Q "RTN","RCDPENR3",372,0) . ;Otherwise print Number format "RTN","RCDPENR3",373,0) . I (I=16) D Q "RTN","RCDPENR3",374,0) . . W:RCERAFLG RCDTXT,?65,$J($P(RCSCDATA,U,I),13,2),! "RTN","RCDPENR3",375,0) . W RCDTXT,?65,$J($P(RCSCDATA,U,I),13),! "RTN","RCDPENR3",376,0) I RCSTOP Q RCSTOP "RTN","RCDPENR3",377,0) I RCDISP W RCLINE,! ;Otherwise print Number format "RTN","RCDPENR3",378,0) I 'RCDISP D SAVEDATA^RCDPENR1(RCLINE,RCRPIEN) "RTN","RCDPENR3",379,0) Q RCSTOP "RTN","RCDPENR3",380,0) ; "RTN","RCDPENR3",381,0) GDTXT ; "RTN","RCDPENR3",382,0) ;;TOTAL NUMBER OF CLAIMS "RTN","RCDPENR3",383,0) ;;TOTAL AMOUNT BILLED "RTN","RCDPENR3",384,0) ;;TOTAL AMOUNT PAID "RTN","RCDPENR3",385,0) ;;PERCENTAGE AMOUNT PAID: (%Total Paid/Billed) "RTN","RCDPENR3",386,0) ;; "RTN","RCDPENR3",387,0) ;;AVG #DAYS BETWEEN BILLED/ERA "RTN","RCDPENR3",388,0) ;;AVG #DAYS BETWEEN ERA/EFT "RTN","RCDPENR3",389,0) ;;AVG #DAYS BETWEEN ERA+EFT REC'D/PMT POSTED "RTN","RCDPENR3",390,0) ;;AVG #DAYS BETWEEN BILLED/PMT POSTED "RTN","RCDPENR3",391,0) ;; "RTN","RCDPENR3",392,0) ;;TOTAL NUMBER OF ERAs "RTN","RCDPENR3",393,0) ;;TOTAL NUMBER OF EEOBs "RTN","RCDPENR3",394,0) ;; "RTN","RCDPENR3",395,0) ;;TOTAL NUMBER OF EFTs "RTN","RCDPENR3",396,0) ;;TOTAL AMOUNT COLLECTED "RTN","RCDPENR3",397,0) ;;TOTAL DIFFERENCE BETWEEN ERAs (PAID) - EFTs (COLLECTED): "RTN","RCDPENR3",398,0) Q "RTN","RCDPEP") 0^9^B154349379 "RTN","RCDPEP",1,0) RCDPEP ;AITC/CJE - FLAG PAYERS AS PHARMACY/TRICARE ; 19-APR-2017 "RTN","RCDPEP",2,0) ;;4.5;Accounts Receivable;**321,326,332**;;Build 40 "RTN","RCDPEP",3,0) ;Per VA Directive 6402, this routine should not be modified. "RTN","RCDPEP",4,0) ; "RTN","RCDPEP",5,0) EN(FILTER,DATEFILT) ; -- main entry point for RCDPE PAYER FLAGS template "RTN","RCDPEP",6,0) ; Input: FILTER - A=All payers, P=Pharmacy payers, T=Tricare payers, "RTN","RCDPEP",7,0) ; M=Medical (Neither Pharmacy nor Tricare) "RTN","RCDPEP",8,0) ; DATEFILT - Additional Filter by Date. Has 3 pieces by '^' "RTN","RCDPEP",9,0) ; Piece 1 - 1=Filter by date, 0=Don't "RTN","RCDPEP",10,0) ; Piece 2 - START - First DATE ADDED to include(FM format) "RTN","RCDPEP",11,0) ; Piece 3 - END - Last DATE ADDED to include (FM format) "RTN","RCDPEP",12,0) ; "RTN","RCDPEP",13,0) I '$D(DATEFILT) S DATEFILT=$$GETDATE() "RTN","RCDPEP",14,0) I DATEFILT=-1 Q ; "RTN","RCDPEP",15,0) I '$D(FILTER) S FILTER=$$GETFILT() "RTN","RCDPEP",16,0) I FILTER=-1 Q ; "RTN","RCDPEP",17,0) ; "RTN","RCDPEP",18,0) D PAYEN^RCDPESP6 ; PRCA*4.5*332 "RTN","RCDPEP",19,0) D EN^VALM("RCDPE PAYER FLAGS") "RTN","RCDPEP",20,0) D PAYEX^RCDPESP6 ; PRCA*4.5*332 "RTN","RCDPEP",21,0) Q "RTN","RCDPEP",22,0) ; "RTN","RCDPEP",23,0) GETDATE() ; Ask if the user wants to filter by date. If so prompt for start "RTN","RCDPEP",24,0) ; and end dates. "RTN","RCDPEP",25,0) ; Input: None "RTN","RCDPEP",26,0) ; Output: Return value=date filter parameters delimiter by '^' "RTN","RCDPEP",27,0) ; Piece 1 - 1=Filter by date, 0=Don't "RTN","RCDPEP",28,0) ; Piece 2 - START - First DATE ADDED to include(FM format) "RTN","RCDPEP",29,0) ; Piece 3 - END - Last DATE ADDED to include (FM format) "RTN","RCDPEP",30,0) ; "RTN","RCDPEP",31,0) N DIR,DIROUT,DIRUT,DTOUT,DUOUT,FD1,FD2,FILTER,OLDDATE,OD1,OD2,RETURN,X,XX,Y "RTN","RCDPEP",32,0) D FULL^VALM1 "RTN","RCDPEP",33,0) S VALMBCK="R" "RTN","RCDPEP",34,0) S RETURN="0" "RTN","RCDPEP",35,0) ; "RTN","RCDPEP",36,0) S XX=$P($P($G(XQORNOD(0)),"^",4),"=",2) ; User selection with action "RTN","RCDPEP",37,0) S FD1=$P(XX,";",2),FD2=$P(XX,";",3) "RTN","RCDPEP",38,0) ; See if user selection is valid (must be T + or - N days) "RTN","RCDPEP",39,0) S FD1=$$PARSED(FD1) "RTN","RCDPEP",40,0) S FD2=$$PARSED(FD2) "RTN","RCDPEP",41,0) I FD1,FD2 Q 1_"^"_FD1_"^"_FD2 "RTN","RCDPEP",42,0) ; "RTN","RCDPEP",43,0) S OLDDATE=$G(DATEFILT,0) "RTN","RCDPEP",44,0) S OD1=$P(OLDDATE,"^",2),OD2=$P(OLDDATE,"^",3) "RTN","RCDPEP",45,0) ; "RTN","RCDPEP",46,0) S DIR(0)="YA" "RTN","RCDPEP",47,0) S DIR("A")="Filter by Date Added? " "RTN","RCDPEP",48,0) S DIR("B")=$S(OLDDATE:"YES",1:"NO") "RTN","RCDPEP",49,0) S DIR("?",1)="Enter 'Y' or 'Yes' to filter the list by DATE ADDED" "RTN","RCDPEP",50,0) S DIR("?")="Enter 'N' or 'No' if you do not wish to filter the list by date" "RTN","RCDPEP",51,0) D ^DIR "RTN","RCDPEP",52,0) I $D(DIRUT) Q -1 "RTN","RCDPEP",53,0) I Y=0 Q 0 "RTN","RCDPEP",54,0) S RETURN=1 "RTN","RCDPEP",55,0) ; "RTN","RCDPEP",56,0) ; Prompt for start and end date "RTN","RCDPEP",57,0) K DIR "RTN","RCDPEP",58,0) S DIR(0)="DA^" "RTN","RCDPEP",59,0) S DIR("A")="Filter start date: " "RTN","RCDPEP",60,0) ; set default to existing filter start date if it is set. "RTN","RCDPEP",61,0) I OD1'="" S DIR("B")=$$FMTE^XLFDT(OD1,"2DZ") "RTN","RCDPEP",62,0) D ^DIR "RTN","RCDPEP",63,0) I $D(DIRUT) Q -1 "RTN","RCDPEP",64,0) S (FD1,$P(RETURN,"^",2))=Y "RTN","RCDPEP",65,0) ; "RTN","RCDPEP",66,0) K DIR "RTN","RCDPEP",67,0) S DIR(0)="DA^"_FD1_":"_DT "RTN","RCDPEP",68,0) S DIR("A")="Filter end date (" "RTN","RCDPEP",69,0) S DIR("A")=DIR("A")_$$FMTE^XLFDT(FD1,"2DZ")_"-" "RTN","RCDPEP",70,0) S DIR("A")=DIR("A")_$$FMTE^XLFDT(DT,"2DZ")_"): " "RTN","RCDPEP",71,0) ; Set default to existing filter end date if it is valid. "RTN","RCDPEP",72,0) ; (it must follow the selected start date). Otherwise default to today. "RTN","RCDPEP",73,0) I OD2'="",OD2'D1&(DC>>> Security key RCDPE PAYER IDENTIFY is required for this action" "RTN","RCDPEP",258,0) . D PAUSE^VALM1 "RTN","RCDPEP",259,0) Q RET(0) "RTN","RCDPEP",260,0) ; "RTN","RCDPEP",261,0) EDIT ; EP - for RCDPE PAYER FLAGS EDIT protocol "RTN","RCDPEP",262,0) ; Input: None "RTN","RCDPEP",263,0) ; Output: File 344.6 is updated "RTN","RCDPEP",264,0) ; Listman array is updated "RTN","RCDPEP",265,0) ; "RTN","RCDPEP",266,0) N DA,DIC,DIE,DO,DR,DTOUT,EDT,LINE,PCNT,PIEN,PROMPT,RET,SEL,X,XX,Y "RTN","RCDPEP",267,0) S VALMBCK="R" "RTN","RCDPEP",268,0) D FULL^VALM1 "RTN","RCDPEP",269,0) ; Check security key for edit access "RTN","RCDPEP",270,0) I '$$CHKKEY() Q ; "RTN","RCDPEP",271,0) ; "RTN","RCDPEP",272,0) S PROMPT="Select a Payer Entry to edit: " "RTN","RCDPEP",273,0) S PIEN=$$SELENT(1,PROMPT,VALMBG,VALMLST,.SEL,"RCDPEPIX",0) "RTN","RCDPEP",274,0) Q:'PIEN "RTN","RCDPEP",275,0) ; "RTN","RCDPEP",276,0) ; Lock Editing of this payer entry "RTN","RCDPEP",277,0) L +^RCY(344.6,PIEN):3 I '$T D Q "RTN","RCDPEP",278,0) . W !!,*7,"Someone else is editing this Payer Entry." "RTN","RCDPEP",279,0) . W !,"Try again later." "RTN","RCDPEP",280,0) . D PAUSE^VALM1 "RTN","RCDPEP",281,0) ; "RTN","RCDPEP",282,0) ; Let the user edit the payer entry "RTN","RCDPEP",283,0) S DIE="^RCY(344.6," "RTN","RCDPEP",284,0) W !!,"Edit flags for payer : "_$$GET1^DIQ(344.6,PIEN_",",.01,"E"),! "RTN","RCDPEP",285,0) S DA=PIEN "RTN","RCDPEP",286,0) S DR=".09Pharmacy Flag;.1Tricare Flag" "RTN","RCDPEP",287,0) D ^DIE "RTN","RCDPEP",288,0) ; "RTN","RCDPEP",289,0) L -^RCY(344.6,PIEN) "RTN","RCDPEP",290,0) D GET1PAY(PIEN,+SEL) "RTN","RCDPEP",291,0) D BLD1PAY(+SEL) "RTN","RCDPEP",292,0) Q "RTN","RCDPEP",293,0) ; "RTN","RCDPEP",294,0) SELENT(FULL,PROMPT,START,END,PCNT,WLIST,MULT) ; EP - Protocol Action "RTN","RCDPEP",295,0) ; Select Entry(s) to perform an action upon "RTN","RCDPEP",296,0) ; Called from protocols : RCDPE PAYER FLAGS EDIT "RTN","RCDPEP",297,0) ; RCDPE PAYER FLAG PHARM "RTN","RCDPEP",298,0) ; RCDPE PAYER FLAG TRIC "RTN","RCDPEP",299,0) ; Input: FULL - 1 - full screen mode, 0 otherwise "RTN","RCDPEP",300,0) ; PROMPT - Prompt to be displayed to the user "RTN","RCDPEP",301,0) ; START - Starting selection value "RTN","RCDPEP",302,0) ; END - Ending selection value "RTN","RCDPEP",303,0) ; WLIST - Worklist, the user is selecting from "RTN","RCDPEP",304,0) ; Optional, defaults to 'RCDPEPIX' "RTN","RCDPEP",305,0) ; MULT - 1 to allow multiple selection, "RTN","RCDPEP",306,0) ; 0 or null otherwise "RTN","RCDPEP",307,0) ; Optional defaults to 0 "RTN","RCDPEP",308,0) ; Output: PCNT - Selected Phone Book Entry line(s) "RTN","RCDPEP",309,0) ; Returns: Selected Payer Entry IEN(s) "RTN","RCDPEP",310,0) ; Error message if invalid selection "RTN","RCDPEP",311,0) N CTR,DIROUT,DIRUT,DLINE,DTOUT,DUOUT,PIEN,PIENS,X,XX,Y,YY "RTN","RCDPEP",312,0) S:'$D(WLIST) WLIST="RCDPEPIX" "RTN","RCDPEP",313,0) S:'$D(MULT) MULT=0 "RTN","RCDPEP",314,0) D:FULL FULL^VALM1 "RTN","RCDPEP",315,0) ; Check for multi-selection "RTN","RCDPEP",316,0) S PCNT=$$PARSEL($G(XQORNOD(0)),START,END) "RTN","RCDPEP",317,0) ; "RTN","RCDPEP",318,0) ; W !!!,"PCNT="_PCNT_" MULT="_MULT H 10 "RTN","RCDPEP",319,0) I 'MULT,$P(PCNT,",",2) D Q "" ; Invalid multi-selection "RTN","RCDPEP",320,0) . W !,*7,">>>> Only single entry selection is allowed" "RTN","RCDPEP",321,0) . K DIR "RTN","RCDPEP",322,0) . D PAUSE^VALM1 "RTN","RCDPEP",323,0) S:PCNT="" PCNT=$$SELENTRY(PROMPT,START,END,MULT) "RTN","RCDPEP",324,0) Q:'PCNT "" "RTN","RCDPEP",325,0) ; "RTN","RCDPEP",326,0) S PIENS="" "RTN","RCDPEP",327,0) F CTR=1:1:$L(PCNT,",") D "RTN","RCDPEP",328,0) . S XX=$P(PCNT,",",CTR) "RTN","RCDPEP",329,0) . I XX'="" D ; "RTN","RCDPEP",330,0) . . S YY=$P(^TMP($J,WLIST,XX),"^",1) "RTN","RCDPEP",331,0) . . S PIENS=$S(PIENS="":YY,1:PIENS_","_YY) "RTN","RCDPEP",332,0) Q PIENS "RTN","RCDPEP",333,0) ; "RTN","RCDPEP",334,0) SELENTRY(PROMPT,START,END,MULT) ; Select a line "RTN","RCDPEP",335,0) ; Input: PROMPT - Prompt to be displayed to the user "RTN","RCDPEP",336,0) ; START - Start comment # that can be selected "RTN","RCDPEP",337,0) ; END - Ending comment # that can be selected "RTN","RCDPEP",338,0) ; MULT - 1=Multiple selection allowed, 0=otherwise "RTN","RCDPEP",339,0) ; Returns: Selected Comment # or "" if not selected "RTN","RCDPEP",340,0) N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y "RTN","RCDPEP",341,0) S MULT=+$G(MULT) "RTN","RCDPEP",342,0) S DIR(0)=$S(MULT:"L",1:"N")_"O^"_START_":"_END_":0" "RTN","RCDPEP",343,0) S DIR("A")=PROMPT "RTN","RCDPEP",344,0) D ^DIR K DIR "RTN","RCDPEP",345,0) Q Y "RTN","RCDPEP",346,0) ; "RTN","RCDPEP",347,0) FLAGP ; EP - for RCDPE PAYER FLAG PHARM protocol "RTN","RCDPEP",348,0) ; Toggle pharmacy flag on selected lines "RTN","RCDPEP",349,0) ; Input: None "RTN","RCDPEP",350,0) ; Output: None "RTN","RCDPEP",351,0) D FLAG("P") "RTN","RCDPEP",352,0) Q "RTN","RCDPEP",353,0) ; "RTN","RCDPEP",354,0) FLAGT ; EP - for RCDPE PAYER FLAG TRIC protocol "RTN","RCDPEP",355,0) ; Toggle Tricare flag on selected lines "RTN","RCDPEP",356,0) ; Input: None "RTN","RCDPEP",357,0) ; Output: None "RTN","RCDPEP",358,0) D FLAG("T") "RTN","RCDPEP",359,0) Q "RTN","RCDPEP",360,0) ; "RTN","RCDPEP",361,0) FLAG(TYPE) ; Flag a list of entries as Pharmacy or Tricare "RTN","RCDPEP",362,0) ; Input: TYPE - P=Pharmacy, T=Tricare "RTN","RCDPEP",363,0) ; Output: File 344.6 is updated "RTN","RCDPEP",364,0) ; ListMan array is updated "RTN","RCDPEP",365,0) N CONTINUE,CTR,FIELD,PERR,PIEN,PIENS,PROMPT,SELS,STOP,XX,ZS,ZZ "RTN","RCDPEP",366,0) S FIELD=$S(TYPE="P":.09,1:.1) "RTN","RCDPEP",367,0) S VALMBCK="R" "RTN","RCDPEP",368,0) ; Check security key for edit access "RTN","RCDPEP",369,0) I '$$CHKKEY() Q ; "RTN","RCDPEP",370,0) ; "RTN","RCDPEP",371,0) S PROMPT="Select lines on which to toggle " "RTN","RCDPEP",372,0) S PROMPT=PROMPT_$S(TYPE="P":"Pharmacy",1:"Tricare")_" Flag" "RTN","RCDPEP",373,0) S PIENS=$$SELENT(1,PROMPT,VALMBG,VALMLST,.SELS,"RCDPEPIX",1) "RTN","RCDPEP",374,0) Q:PIENS="" ; "RTN","RCDPEP",375,0) S (PERR,PIEN,ZZ,ZS)="" "RTN","RCDPEP",376,0) ; "RTN","RCDPEP",377,0) ; First lock all entries to be deleted "RTN","RCDPEP",378,0) F CTR=1:1:$L(PIENS,",") D "RTN","RCDPEP",379,0) . S PIEN=$P(PIENS,",",CTR) I PIEN="" Q ; "RTN","RCDPEP",380,0) . S XX=$P(SELS,",",CTR) "RTN","RCDPEP",381,0) . ; "RTN","RCDPEP",382,0) . ; Lock this payer exclusion for editing "RTN","RCDPEP",383,0) . L +^RCY(344.6,PIEN):3 I '$T D Q "RTN","RCDPEP",384,0) . . S PERR=$S(PERR="":XX,1:PERR_","_XX) "RTN","RCDPEP",385,0) . S ZZ=$S(ZZ="":PIEN,1:ZZ_","_PIEN) "RTN","RCDPEP",386,0) . S ZS=$S(ZS="":XX,1:ZS_","_XX) "RTN","RCDPEP",387,0) S PIENS=ZZ ; Entry(s) that can be deleted "RTN","RCDPEP",388,0) S SELS=ZS "RTN","RCDPEP",389,0) ; "RTN","RCDPEP",390,0) ; Did we lock at least one entry? "RTN","RCDPEP",391,0) I PIENS="" D Q "RTN","RCDPEP",392,0) . W !!,*7,"All entries are being edited by another user - Nothing done." "RTN","RCDPEP",393,0) . D PAUSE^VALM1 "RTN","RCDPEP",394,0) ; "RTN","RCDPEP",395,0) ; Next warn the user if we couldn't lock them all "RTN","RCDPEP",396,0) I PERR'="" D Q:STOP "RTN","RCDPEP",397,0) . S STOP=0 "RTN","RCDPEP",398,0) . W !!,*7,"Warning: The following entries: ",PERR," are being edited by another user" "RTN","RCDPEP",399,0) . W !,"These entries will not be updated." "RTN","RCDPEP",400,0) . S CONTINUE=$$ASKYN("Continue with update of other payers?") "RTN","RCDPEP",401,0) . I 'CONTINUE D "RTN","RCDPEP",402,0) . . S STOP=1 "RTN","RCDPEP",403,0) . . F CTR=1:1:$L(PIENS,",") D "RTN","RCDPEP",404,0) . . . S PIEN=$P(PIENS,",",CTR) "RTN","RCDPEP",405,0) . . . L -^RCY(344.6,PIEN) "RTN","RCDPEP",406,0) ; "RTN","RCDPEP",407,0) ; Flag selected entries "RTN","RCDPEP",408,0) F CTR=1:1:$L(PIENS,",") D ; "RTN","RCDPEP",409,0) . N FDA,IENS,OLDVAL,VALUE "RTN","RCDPEP",410,0) . S PIEN=$P(PIENS,",",CTR) "RTN","RCDPEP",411,0) . S IENS=PIEN_"," "RTN","RCDPEP",412,0) . S SEL=$P(SELS,",",CTR) "RTN","RCDPEP",413,0) . S OLDVAL=$$GET1^DIQ(344.6,IENS,FIELD,"I") "RTN","RCDPEP",414,0) . S VALUE=$S('OLDVAL:1,1:0) "RTN","RCDPEP",415,0) . S FDA(344.6,IENS,FIELD)=VALUE "RTN","RCDPEP",416,0) . L -^RCY(344.6,PIEN) "RTN","RCDPEP",417,0) . D FILE^DIE("","FDA") "RTN","RCDPEP",418,0) . D GET1PAY(PIEN,SEL) "RTN","RCDPEP",419,0) . D BLD1PAY(SEL) "RTN","RCDPEP",420,0) Q "RTN","RCDPEP",421,0) ; "RTN","RCDPEP",422,0) FILTER ; EP - for RCDPE PAYER FLAGS FILTER protocol "RTN","RCDPEP",423,0) ; Change the filter from a protocol "RTN","RCDPEP",424,0) ; Inputs - None "RTN","RCDPEP",425,0) ; Output - Sets variables FILTER and DATEFILT "RTN","RCDPEP",426,0) N NEWDATE,NEWFILT "RTN","RCDPEP",427,0) S VALMBCK="R" "RTN","RCDPEP",428,0) D FULL^VALM1 "RTN","RCDPEP",429,0) S NEWDATE=$$GETDATE() "RTN","RCDPEP",430,0) I NEWDATE=-1 Q ; "RTN","RCDPEP",431,0) S NEWFILT=$$GETFILT() "RTN","RCDPEP",432,0) I NEWFILT=-1 Q ; "RTN","RCDPEP",433,0) S DATEFILT=NEWDATE "RTN","RCDPEP",434,0) S FILTER=NEWFILT "RTN","RCDPEP",435,0) D HDR,INIT "RTN","RCDPEP",436,0) Q "RTN","RCDPEP",437,0) ; "RTN","RCDPEP",438,0) PARSEL(VALMNOD,BEG,END) ; -- split out pre-answers from user "RTN","RCDPEP",439,0) ; Inputs - VALMNOD= User input from protocol menu including pre-answers "RTN","RCDPEP",440,0) ; BEG=Begining of the valid numeric range "RTN","RCDPEP",441,0) ; END=End of the valid numeric range "RTN","RCDPEP",442,0) ; Returns - Y=Comma separated list of valid numeric entries "RTN","RCDPEP",443,0) ; "RTN","RCDPEP",444,0) ; This code is adapted from VALM2. "RTN","RCDPEP",445,0) N I,J,L,X,Y "RTN","RCDPEP",446,0) S Y=$TR($P($P(VALMNOD,U,4),"=",2),"/\; .",",,,,,") "RTN","RCDPEP",447,0) ; Run through the list, skip invalid selections and expand ranges "RTN","RCDPEP",448,0) S X=Y,Y="" "RTN","RCDPEP",449,0) F I=1:1 S J=$P(X,",",I) Q:J="" D ; "RTN","RCDPEP",450,0) . I J'["-",J>(BEG-1),J<(END+1) S Y=Y_J_"," ; single valid selection "RTN","RCDPEP",451,0) . I J["-",J,J<$P(J,"-",2) D ; "RTN","RCDPEP",452,0) . . F L=+J:1:+$P(J,"-",2) D ; "RTN","RCDPEP",453,0) . . . I L>(BEG-1),L<(END+1) S Y=Y_L_"," ; valid selection from expanded range "RTN","RCDPEP",454,0) Q Y "RTN","RCDPEP",455,0) ; "RTN","RCDPEP",456,0) PARSED(X) ; Take a date in external format and check if it is a valid "RTN","RCDPEP",457,0) ; DATE ADDED (.03) in file 344.6 "RTN","RCDPEP",458,0) ; Input - Date in External format "RTN","RCDPEP",459,0) ; Output - Date in Fileman format or 0 if the input was invalid "RTN","RCDPEP",460,0) D VAL^DIE(344.6,"+1,",.03,"",X,.RET) "RTN","RCDPEP",461,0) Q RET "RTN","RCDPEP",462,0) ; "RTN","RCDPEP",463,0) ASKYN(PROMPT,DEFAULT) ; Ask a yes/no question "RTN","RCDPEP",464,0) ; Input: PROMPT - Question to be asked "RTN","RCDPEP",465,0) ; DEFAULT - Default Answer "RTN","RCDPEP",466,0) ; 1 - YES, 0 - NO "RTN","RCDPEP",467,0) ; Optional, defaults to 0 "RTN","RCDPEP",468,0) ; Returns: 1 - User answered YES, 0 othewise "RTN","RCDPEP",469,0) N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y "RTN","RCDPEP",470,0) S:$G(DEFAULT)'=1 DEFAULT=0 "RTN","RCDPEP",471,0) S DIR(0)="Y",DIR("A")=PROMPT "RTN","RCDPEP",472,0) S DIR("B")=$S(DEFAULT:"YES",1:"NO") "RTN","RCDPEP",473,0) D ^DIR "RTN","RCDPEP",474,0) Q Y "RTN","RCDPEP",475,0) ; "RTN","RCDPEP",476,0) HELP ; EP - for template RCDPE PAYER FLAGS help "RTN","RCDPEP",477,0) ; Input: None "RTN","RCDPEP",478,0) ; Output: Text from a help frame displayed to the screen "RTN","RCDPEP",479,0) N FILTER,DATEFILT,XQH "RTN","RCDPEP",480,0) S VALMBCK="R" "RTN","RCDPEP",481,0) S XQH="RCDPE PAYER FLAGS GENERAL" "RTN","RCDPEP",482,0) D EN^XQH "RTN","RCDPEP",483,0) Q "RTN","RCDPEP",484,0) ; "RTN","RCDPEP",485,0) EXIT ; -- exit code "RTN","RCDPEP",486,0) D FULL^VALM1 "RTN","RCDPEP",487,0) Q "RTN","RCDPESP") 0^20^B142229287 "RTN","RCDPESP",1,0) RCDPESP ;BIRM/EWL - ePayment Lockbox Site Parameters Definition - Files 344.61 & 344.6 ;27 Sept 2018 15:56:10 "RTN","RCDPESP",2,0) ;;4.5;Accounts Receivable;**298,304,318,321,326,332**;Mar 20, 1995;Build 40 "RTN","RCDPESP",3,0) ;Per VA Directive 6402, this routine should not be modified. "RTN","RCDPESP",4,0) ; "RTN","RCDPESP",5,0) EN ; entry point for EDI Lockbox Parameters [RCDPE EDI LOCKBOX PARAMETERS] "RTN","RCDPESP",6,0) N DA,DIC,DIE,DIR,DIRUT,DLAYGO,DR,DTOUT,DUOUT,X,Y ; FileMan variables "RTN","RCDPESP",7,0) ; "RTN","RCDPESP",8,0) W !," Update AR Site Parameters",! "RTN","RCDPESP",9,0) ; "RTN","RCDPESP",10,0) S X="RCDPE AUTO DEC" I '$D(^XUSEC(X,DUZ)) W !!,"You do not hold the "_X_" security key." Q "RTN","RCDPESP",11,0) ; Lock the parameter file "RTN","RCDPESP",12,0) L +^RCY(344.61,1):DILOCKTM E D Q "RTN","RCDPESP",13,0) . W !!," Another user is currently using the AR Site Parameters option." "RTN","RCDPESP",14,0) . W !," Please try again later." "RTN","RCDPESP",15,0) ; "RTN","RCDPESP",16,0) ; PRCA*4.5*326 - Once lock is successful, take a snapshot of the parameters for monitoring "RTN","RCDPESP",17,0) D EN^RCDPESP6 "RTN","RCDPESP",18,0) ; "RTN","RCDPESP",19,0) ; Check parameter file "RTN","RCDPESP",20,0) N FDAEDI,FDAPAYER,IEN,IENS,RCQUIT "RTN","RCDPESP",21,0) ; FDAPAYER - FDA array for RCDPE AUTO-PAY EXCLUSION file (#344.6) "RTN","RCDPESP",22,0) ; FDAEDI - FDA array for RCDPE PARAMETER file (#344.61) "RTN","RCDPESP",23,0) ; RCAUDVAL - audit data for RCDPE PARAMETER AUDIT file (#344.7) "RTN","RCDPESP",24,0) ; IEN - entry # "RTN","RCDPESP",25,0) ; IENS - IEN_comma "RTN","RCDPESP",26,0) ; RCQUIT - exit flag "RTN","RCDPESP",27,0) ; "RTN","RCDPESP",28,0) ; function returns 1 on success "RTN","RCDPESP",29,0) S Y=$$EDILOCK^RCMSITE ; Update EDI Lockbox site parameters "RTN","RCDPESP",30,0) I 'Y G ABORT ; user entered '^' "RTN","RCDPESP",31,0) ; "RTN","RCDPESP",32,0) ; PRCA*4.5*304 - Enable/disable auto-auditing of paper bills "RTN","RCDPESP",33,0) S RCQUIT=0 W ! "RTN","RCDPESP",34,0) S RCQUIT=$$AUDIT^RCDPESP5 "RTN","RCDPESP",35,0) I RCQUIT G ABORT ; PRCA*4.5*326 must have single exit point "RTN","RCDPESP",36,0) ; "RTN","RCDPESP",37,0) W ! "RTN","RCDPESP",38,0) I '$D(^RCY(344.61,1,0)) W !,"There is a problem with the RCDPE PARAMETER file (#344.61)." G EXIT "RTN","RCDPESP",39,0) ; "RTN","RCDPESP",40,0) ; PRCA*4.5*321 "RTN","RCDPESP",41,0) ; WORKLOAD NOTIFICATION BULLETIN DAYS "RTN","RCDPESP",42,0) N BULL S BULL=$$GET1^DIQ(344.61,"1,",.1,"I") "RTN","RCDPESP",43,0) K DIR S:BULL]"" DIR("B")=$$GET1^DIQ(344.61,"1,",.1,"E") "RTN","RCDPESP",44,0) S DIR("?")=$$GET1^DID(344.61,.1,,"HELP-PROMPT") "RTN","RCDPESP",45,0) S DIR("A")=$$GET1^DID(344.61,.1,,"TITLE") "RTN","RCDPESP",46,0) S DIR(0)="344.61,.1" "RTN","RCDPESP",47,0) D ^DIR I $D(DTOUT)!$D(DUOUT) G ABORT "RTN","RCDPESP",48,0) I BULL'=Y D ; update and audit "RTN","RCDPESP",49,0) . S RCAUDVAL(1)="344.61^.1^1^"_Y_U_BULL "RTN","RCDPESP",50,0) . S FDAEDI(344.61,"1,",.1)=Y D FILE^DIE(,"FDAEDI") "RTN","RCDPESP",51,0) . D AUDIT(.RCAUDVAL) K RCAUDVAL "RTN","RCDPESP",52,0) W ! "RTN","RCDPESP",53,0) ; "RTN","RCDPESP",54,0) ; Enable/disable auto-posting of medical claims "RTN","RCDPESP",55,0) N APMC,APMCT "RTN","RCDPESP",56,0) ;PRCA*4.5*304 Move from Medical Auto decrease section below "RTN","RCDPESP",57,0) N ADMC ; ^DD(344.61,.02,0)="AUTO-POST MED CLAIMS ENABLED^S^0:No;1:Yes;^0;2^Q" "RTN","RCDPESP",58,0) S ADMC="" ; Init in case Medical Auto Posting is turned off. "RTN","RCDPESP",59,0) ;end PRCA*4.5*304 "RTN","RCDPESP",60,0) ; APMC=AUTO POSTING OF MEDICAL CLAIMS ENABLED "RTN","RCDPESP",61,0) ; APMCT=TEMP APMC "RTN","RCDPESP",62,0) S APMCT=$$GET1^DIQ(344.61,"1,",.02,"I"),APMC=$S(APMCT=1:"Yes",APMCT=0:"No",1:"") "RTN","RCDPESP",63,0) K DIR S DIR(0)="YA",DIR("B")=$S(APMC="":"Y",1:APMC) "RTN","RCDPESP",64,0) S DIR("A")=$$GET1^DID(344.61,.02,,"TITLE") "RTN","RCDPESP",65,0) S DIR("?")=$$GET1^DID(344.61,.02,,"HELP-PROMPT") "RTN","RCDPESP",66,0) D ^DIR I $D(DTOUT)!$D(DUOUT) G ABORT "RTN","RCDPESP",67,0) I APMCT'=Y D ; user updated value "RTN","RCDPESP",68,0) .S FDAEDI(344.61,"1,",.02)=Y D FILE^DIE(,"FDAEDI") K FDAEDI "RTN","RCDPESP",69,0) .D NOTIFY($S(Y=1:"Yes",Y=0:"No",1:"*missing*")) "RTN","RCDPESP",70,0) .S RCAUDVAL(1)="344.61^.02^1^"_Y_U_('Y) D AUDIT(.RCAUDVAL) K RCAUDVAL "RTN","RCDPESP",71,0) ; "RTN","RCDPESP",72,0) I Y=0 G RXPARMS "RTN","RCDPESP",73,0) ; "RTN","RCDPESP",74,0) ; Set/Reset payer exclusions for medical claim posting "RTN","RCDPESP",75,0) D EXCLLIST(1) ; Display the exclusion list "RTN","RCDPESP",76,0) D SETEXCL(1) I $G(RCQUIT) G ABORT ; SET/RESET exclusions "RTN","RCDPESP",77,0) D EXCLLIST(1) ; Display the exclusion list "RTN","RCDPESP",78,0) W ! "RTN","RCDPESP",79,0) ; "RTN","RCDPESP",80,0) ; Enable/disable auto-decrease of paid medical claims "RTN","RCDPESP",81,0) N RETURN "RTN","RCDPESP",82,0) S RETURN=$$PAID^RCDPESP7 "RTN","RCDPESP",83,0) G:RETURN=2 RXPARMS "RTN","RCDPESP",84,0) ; "RTN","RCDPESP",85,0) ; Enable/disable auto-decrease of non-paid medical claims "RTN","RCDPESP",86,0) I RETURN=0 S RETURN=$$NOPAY^RCDPESP7 "RTN","RCDPESP",87,0) ; "RTN","RCDPESP",88,0) I RETURN=1 G ABORT "RTN","RCDPESP",89,0) ; "RTN","RCDPESP",90,0) ; Set/Reset payer exclusions for medical claim decrease "RTN","RCDPESP",91,0) D EXCLLIST(2) ; Display the exclusion list "RTN","RCDPESP",92,0) D SETEXCL(2) I $G(RCQUIT) G ABORT ; SET/RESET exclusions "RTN","RCDPESP",93,0) D EXCLLIST(2) ; Display the exclusion list "RTN","RCDPESP",94,0) W ! "RTN","RCDPESP",95,0) ; "RTN","RCDPESP",96,0) ; code falls through "RTN","RCDPESP",97,0) ; "RTN","RCDPESP",98,0) RXPARMS ; branch here from above "RTN","RCDPESP",99,0) ; "RTN","RCDPESP",100,0) ; Enable/disable auto-posting of pharmacy claims "RTN","RCDPESP",101,0) N APPC,APPCT "RTN","RCDPESP",102,0) ; APPC=AUTO POSTING OF PHARMACY CLAIMS ENABLED "RTN","RCDPESP",103,0) ; APPCT=TEMP APMC "RTN","RCDPESP",104,0) S APPCT=$$GET1^DIQ(344.61,"1,",1.01,"I"),APPC=$S(APPCT=1:"Yes",APPCT=0:"No",1:"") "RTN","RCDPESP",105,0) K DIR S DIR(0)="YA",DIR("B")=$S(APPC="":"Yes",1:APPC) "RTN","RCDPESP",106,0) S DIR("A")=$$GET1^DID(344.61,1.01,,"TITLE") "RTN","RCDPESP",107,0) S DIR("?")=$$GET1^DID(344.61,1.01,,"HELP-PROMPT") "RTN","RCDPESP",108,0) D ^DIR I $D(DTOUT)!$D(DUOUT) G ABORT "RTN","RCDPESP",109,0) I APPCT'=Y D ; user updated value "RTN","RCDPESP",110,0) . S FDAEDI(344.61,"1,",1.01)=Y D FILE^DIE(,"FDAEDI") K FDAEDI "RTN","RCDPESP",111,0) . D NOTIFY($S(Y=1:"Yes",Y=0:"No",1:"*missing*"),1) "RTN","RCDPESP",112,0) . S RCAUDVAL(1)="344.61^1.01^1^"_Y_U_('Y) D AUDIT(.RCAUDVAL) K RCAUDVAL "RTN","RCDPESP",113,0) ; "RTN","RCDPESP",114,0) ; If yes, set/Reset payer exclusions for pharmacy claims posting "RTN","RCDPESP",115,0) I Y=1 D G:$G(RCQUIT)=1 ABORT "RTN","RCDPESP",116,0) . D EXCLLIST(3) ; Display the exclusion list "RTN","RCDPESP",117,0) . D SETEXCL(3) Q:$G(RCQUIT) ; SET/RESET exclusions "RTN","RCDPESP",118,0) . D EXCLLIST(3) ; Display the exclusion list "RTN","RCDPESP",119,0) . W ! "RTN","RCDPESP",120,0) ; "RTN","RCDPESP",121,0) ; Show Pharmacy prompt but don't allow change "RTN","RCDPESP",122,0) D:$$GET1^DIQ(344.61,"1,",1.01,"I")=1 G:$G(RCQUIT)=1 ABORT "RTN","RCDPESP",123,0) . W !,"ENABLE AUTO-DECREASE OF PHARMACY CLAIMS (Y/N): NO//" "RTN","RCDPESP",124,0) . W !," Determines if auto-decrease of pharmacy claims are enabled for this site." "RTN","RCDPESP",125,0) . W !," NOTE: Not editable and set to Disabled until further notice.",! "RTN","RCDPESP",126,0) . K DIR S DIR(0)="EA" "RTN","RCDPESP",127,0) . S DIR("A")="Press Enter to continue: " "RTN","RCDPESP",128,0) . D ^DIR I $D(DTOUT)!$D(DUOUT) S RCQUIT=1 "RTN","RCDPESP",129,0) . W ! "RTN","RCDPESP",130,0) ; "RTN","RCDPESP",131,0) ; ^DD(344.61,.06,0) = MEDICAL EFT POST PREVENT DAYS "RTN","RCDPESP",132,0) N MEO S MEO=$$GET1^DIQ(344.61,"1,",.06) "RTN","RCDPESP",133,0) K DIR S:MEO]"" DIR("B")=MEO "RTN","RCDPESP",134,0) S DIR("?")=$$GET1^DID(344.61,.06,,"HELP-PROMPT") "RTN","RCDPESP",135,0) S DIR(0)="NA^14:60:0",DIR("A")=$$GET1^DID(344.61,.06,,"TITLE") ; PRCA*4.5*321 Change max from 99 to 60 "RTN","RCDPESP",136,0) D ^DIR I $D(DTOUT)!$D(DUOUT) G ABORT "RTN","RCDPESP",137,0) I MEO'=Y D ; update and audit "RTN","RCDPESP",138,0) . S RCAUDVAL(1)="344.61^.06^1^"_Y_U_MEO "RTN","RCDPESP",139,0) . S FDAEDI(344.61,"1,",.06)=Y D FILE^DIE(,"FDAEDI") "RTN","RCDPESP",140,0) . D AUDIT(.RCAUDVAL) K RCAUDVAL "RTN","RCDPESP",141,0) ; "RTN","RCDPESP",142,0) ; (#.07) PHARMACY EFT POST PREVENT DAYS [7N] "RTN","RCDPESP",143,0) N PEO S PEO=$$GET1^DIQ(344.61,"1,",.07) "RTN","RCDPESP",144,0) K DIR S:PEO]"" DIR("B")=PEO "RTN","RCDPESP",145,0) S DIR("?")=$$GET1^DID(344.61,.07,,"HELP-PROMPT") "RTN","RCDPESP",146,0) S DIR(0)="NA^21:99:0",DIR("A")=$$GET1^DID(344.61,.07,,"TITLE") ; PRCA*4.5*332 Change max from 365 TO 99 "RTN","RCDPESP",147,0) D ^DIR I $D(DTOUT)!$D(DUOUT) G ABORT "RTN","RCDPESP",148,0) I PEO'=Y D ; update and audit "RTN","RCDPESP",149,0) . S RCAUDVAL(1)="344.61^.07^1^"_Y_U_PEO "RTN","RCDPESP",150,0) . S FDAEDI(344.61,"1,",.07)=Y D FILE^DIE(,"FDAEDI") "RTN","RCDPESP",151,0) . D AUDIT(.RCAUDVAL) K RCAUDVAL "RTN","RCDPESP",152,0) ; "RTN","RCDPESP",153,0) ; (#.13) TRICARE EFT POST PREVENT DAYS [13N] - PRCA*4.5*332 "RTN","RCDPESP",154,0) N PEO S PEO=$$GET1^DIQ(344.61,"1,",.13) "RTN","RCDPESP",155,0) K DIR "RTN","RCDPESP",156,0) S:PEO]"" DIR("B")=PEO "RTN","RCDPESP",157,0) S DIR("?")=$$GET1^DID(344.61,.13,,"HELP-PROMPT") "RTN","RCDPESP",158,0) S DIR(0)="NA^14:60:0",DIR("A")=$$GET1^DID(344.61,.13,,"TITLE")_" " "RTN","RCDPESP",159,0) D ^DIR "RTN","RCDPESP",160,0) I $D(DTOUT)!$D(DUOUT) D ABORT Q "RTN","RCDPESP",161,0) I PEO'=Y D ; Update and audit "RTN","RCDPESP",162,0) . S RCAUDVAL(1)="344.61^.13^1^"_Y_U_PEO "RTN","RCDPESP",163,0) . S FDAEDI(344.61,"1,",.13)=Y D FILE^DIE(,"FDAEDI") "RTN","RCDPESP",164,0) . D AUDIT(.RCAUDVAL) K RCAUDVAL "RTN","RCDPESP",165,0) ; "RTN","RCDPESP",166,0) G EXIT "RTN","RCDPESP",167,0) ; "RTN","RCDPESP",168,0) ABORT ; Called when user enters a '^' or times out "RTN","RCDPESP",169,0) ; fall through to EXIT "RTN","RCDPESP",170,0) ; "RTN","RCDPESP",171,0) EXIT ; Unlock, ask user to press return, exit "RTN","RCDPESP",172,0) D EXIT^RCDPESP6 ; PRCA*4.5*326 - Send mail message if parameters have been edited. "RTN","RCDPESP",173,0) L -^RCY(344.61,1) "RTN","RCDPESP",174,0) D PAUSE "RTN","RCDPESP",175,0) Q "RTN","RCDPESP",176,0) ; "RTN","RCDPESP",177,0) PAUSE ; prompt user to press return "RTN","RCDPESP",178,0) W ! N DIR "RTN","RCDPESP",179,0) S DIR("T")=3,DIR(0)="E",DIR("A")="Press RETURN to continue" D ^DIR "RTN","RCDPESP",180,0) Q "RTN","RCDPESP",181,0) ; "RTN","RCDPESP",182,0) COUNT(TYPE) ; Count active CARCs in file 344.62 (RCDPE CARC-RARC AUTO DEC) "RTN","RCDPESP",183,0) N NUM,I "RTN","RCDPESP",184,0) I (TYPE'=1)&(TYPE'=0) Q 0 ; If TYPE is not active (1) or in-active (0) quit with count = 0 "RTN","RCDPESP",185,0) S NUM=0 "RTN","RCDPESP",186,0) S I="" F S I=$O(^RCY(344.62,"ACTV",TYPE,I)) Q:I="" S NUM=NUM+1 "RTN","RCDPESP",187,0) Q NUM "RTN","RCDPESP",188,0) ; "RTN","RCDPESP",189,0) EXCLLIST(TYP) ; CHOICE determines which exclusions to list "RTN","RCDPESP",190,0) ; TYP - TYPE OF EXLUSION - REQUIRED "RTN","RCDPESP",191,0) ; IX - which index to use "RTN","RCDPESP",192,0) ; IEN - points to an excluded payer for the selected choice "RTN","RCDPESP",193,0) Q:'("^1^2^3^"[(U_$G(TYP)_U)) ; one or two only "RTN","RCDPESP",194,0) N IX,IEN,CT,LIST S (IEN,CT)=0 W ! "RTN","RCDPESP",195,0) S IX=$S(TYP=1:"EXMDPOST",TYP=2:"EXMDDECR",TYP=3:"EXRXPOST",1:"") ;,TYP=4:"EXRXDECR",1:"") "RTN","RCDPESP",196,0) S LIST=$S(TYP=1:"",TYP=3:"",1:"** Additional ")_"Payers excluded from "_$S(TYP=1:"Medical Auto-Posting:",TYP=3:"Pharmacy Auto-Posting",1:"Medical Auto-Decrease:") "RTN","RCDPESP",197,0) F S IEN=$O(^RCY(344.6,IX,1,IEN)) Q:'IEN D "RTN","RCDPESP",198,0) . S CT=CT+1 "RTN","RCDPESP",199,0) . W:CT=1 !,LIST "RTN","RCDPESP",200,0) . W !," "_$P(^RCY(344.6,IEN,0),U,1)_" "_$P(^RCY(344.6,IEN,0),U,2) "RTN","RCDPESP",201,0) ; "RTN","RCDPESP",202,0) I TYP=2 W !,"All payers excluded from Auto-Posting are also excluded from Auto-Decrease." "RTN","RCDPESP",203,0) W:CT=0 !," No "_$S(TYP=2:"additional ",1:"")_"payers excluded from "_$S(TYP=1:"Medical Auto-Posting:",TYP=3:"Pharmacy Auto-Posting",1:"Medical Auto-Decrease:") "RTN","RCDPESP",204,0) ; if list is for auto-decrease and there are exclusions write a message "RTN","RCDPESP",205,0) Q "RTN","RCDPESP",206,0) ; "RTN","RCDPESP",207,0) SETEXCL(TYP) ; LOOP FOR SETTING PAYER EXCLUSIONS "RTN","RCDPESP",208,0) ; TYP - TYPE OF EXLUSION - REQUIRED "RTN","RCDPESP",209,0) N CMT,CT,DIC,DIR,DONE,FDAPAYER,FLD,IEN,PREC,RCAUDVAL,RTYP,X,Y "RTN","RCDPESP",210,0) ; FDAPAYER - FDA FOR FILE 344.6 "RTN","RCDPESP",211,0) ; FLD - FIELD BEING MODIFIED "RTN","RCDPESP",212,0) ; RTYP - STRING REPRESENTING FIELD "RTN","RCDPESP",213,0) ; DONE - INDICATOR TO LEAVE LOOP "RTN","RCDPESP",214,0) ; RCAUDVAL - ARRAY FOR AUDITING "RTN","RCDPESP",215,0) ; PREC - HOLDER FOR Y(0) AFTER ^DIC CALL "RTN","RCDPESP",216,0) ; FILE NUMBER^FIELD NUMBER^IEN^NEW VALUE^OLD VALUE,COMMENT "RTN","RCDPESP",217,0) I $G(TYP)=1 S FLD=.06,CMT=1,RTYP="MEDICAL CLAIMS POSTING" "RTN","RCDPESP",218,0) I $G(TYP)=2 S FLD=.07,CMT=2,RTYP="MEDICAL CLAIMS DECREASE" "RTN","RCDPESP",219,0) I $G(TYP)=3 S FLD=.08,CMT=3,RTYP="PHARMACY CLAIMS POSTING" "RTN","RCDPESP",220,0) I '$D(FLD) Q "RTN","RCDPESP",221,0) ; "RTN","RCDPESP",222,0) W !!,"Select a Payer to add or remove from the exclusion list.",! "RTN","RCDPESP",223,0) S (RCQUIT,CT,DONE)=0 F Q:DONE!RCQUIT D "RTN","RCDPESP",224,0) . S DIC="^RCY(344.6,",DIC(0)="AEMQZ",DIC("A")="Payer: " D ^DIC I X="^" S RCQUIT=1 Q "RTN","RCDPESP",225,0) . I +$G(Y)<1 S DONE=1 Q "RTN","RCDPESP",226,0) . S CT=CT+1,IEN=+Y,IENS=IEN_",",PREC=Y(0) "RTN","RCDPESP",227,0) . K FDAPAYER "RTN","RCDPESP",228,0) . N COMMENT,STAT "RTN","RCDPESP",229,0) . S COMMENT="",STAT='$$GET1^DIQ(344.6,IENS,FLD,"I") "RTN","RCDPESP",230,0) . S FDAPAYER(344.6,IENS,FLD)=STAT "RTN","RCDPESP",231,0) . ; GET COMMENT HERE "RTN","RCDPESP",232,0) . K Y S DIR("A")="COMMENT: ",DIR(0)="FA^3:72" "RTN","RCDPESP",233,0) . S DIR("PRE")="S X=$$TRIM^XLFSTR(X,""LR"")" ; comment required and should be significant "RTN","RCDPESP",234,0) . S DIR("?")="Enter an explanation for "_$S(STAT:"adding the payer to",1:"removing the payer from")_" the list of Excluded Payers." "RTN","RCDPESP",235,0) . D ^DIR I $D(DTOUT)!$D(DUOUT)!(Y="") S RCQUIT=1 Q "RTN","RCDPESP",236,0) . S COMMENT=Y "RTN","RCDPESP",237,0) . I COMMENT]"" D "RTN","RCDPESP",238,0) .. S FDAPAYER(344.6,IENS,CMT)=$S(STAT:COMMENT,1:"") "RTN","RCDPESP",239,0) .. W !,$P(PREC,U)_" "_$P(PREC,U,2)_" has been " "RTN","RCDPESP",240,0) .. W $S(STAT:"added to",1:"removed from")_" the list of Excluded Payers" "RTN","RCDPESP",241,0) .. I TYP=1 D "RTN","RCDPESP",242,0) ... W !,"If medical auto-decrease is turned on, " "RTN","RCDPESP",243,0) ... I STAT W "this payer will be excluded from medical auto-decrease too." "RTN","RCDPESP",244,0) ... I 'STAT,'$$GET1^DIQ(344.6,IEN_",",.07,"I") W "this payer will no longer be excluded from Medical Auto-Decrease." "RTN","RCDPESP",245,0) ... I 'STAT,$$GET1^DIQ(344.6,IEN_",",.07,"I") W "Medical Auto-Decrease is set to be excluded for this payer." "RTN","RCDPESP",246,0) .. K RCAUDVAL "RTN","RCDPESP",247,0) .. D FILE^DIE(,"FDAPAYER") "RTN","RCDPESP",248,0) .. S RCAUDVAL(1)="344.6"_U_FLD_U_IEN_U_STAT_U_('STAT)_U_COMMENT "RTN","RCDPESP",249,0) .. D AUDIT(.RCAUDVAL) K RCAUDVAL "RTN","RCDPESP",250,0) Q "RTN","RCDPESP",251,0) ; "RTN","RCDPESP",252,0) NOTIFY(VAL,TYPE) ; Notify CBO team of change to Site Parameters "RTN","RCDPESP",253,0) N GLB,GLO,MSG,SITE,SUBJ,XMINSTR,XMTO "RTN","RCDPESP",254,0) S SITE=$$SITE^VASITE "RTN","RCDPESP",255,0) S TYPE=+$G(TYPE) ;init optional parameter "RTN","RCDPESP",256,0) ; limit subject to 65 chars. "RTN","RCDPESP",257,0) S SUBJ=$E("Site Parameter edit, Station #"_$P(SITE,U,3)_" - "_$P(SITE,U,2),1,65) "RTN","RCDPESP",258,0) S MSG(1)=" " "RTN","RCDPESP",259,0) S MSG(2)=" Site: "_$P(SITE,U,2) "RTN","RCDPESP",260,0) S MSG(3)=" Station #: "_$P(SITE,U,3) "RTN","RCDPESP",261,0) S MSG(4)=" Domain: "_$G(^XMB("NETNAME")) "RTN","RCDPESP",262,0) S MSG(5)=" Date/Time: "_$$FMTE^XLFDT($$NOW^XLFDT,"5ZPM") "RTN","RCDPESP",263,0) S MSG(6)=" Changed by: "_$P($G(^VA(200,DUZ,0)),U) "RTN","RCDPESP",264,0) S MSG(7)=" " "RTN","RCDPESP",265,0) S MSG(8)=" ENABLE AUTO-POSTING OF "_$S(TYPE=1:"PHARMACY",1:"MEDICAL")_" CLAIMS = "_VAL "RTN","RCDPESP",266,0) S MSG(9)=" " "RTN","RCDPESP",267,0) ;Copy message to ePayments CBO team "RTN","RCDPESP",268,0) S XMTO(DUZ)="" "RTN","RCDPESP",269,0) ; S:$$PROD^XUPROD XMTO("VHAEPAYMENTS@domain.ext")="" ; PRCA*4.5*326 autopost on/off message no longer required by ePay "RTN","RCDPESP",270,0) ; "RTN","RCDPESP",271,0) K ^TMP("XMERR",$J) "RTN","RCDPESP",272,0) D SENDMSG^XMXAPI(DUZ,SUBJ,"MSG",.XMTO,.XMINSTR) "RTN","RCDPESP",273,0) ; "RTN","RCDPESP",274,0) I $D(^TMP("XMERR",$J)) D "RTN","RCDPESP",275,0) .D MES^XPDUTL("MailMan reported a problem trying to send the notification message.") "RTN","RCDPESP",276,0) .D MES^XPDUTL(" ") "RTN","RCDPESP",277,0) .S (GLO,GLB)="^TMP(""XMERR"","_$J "RTN","RCDPESP",278,0) .S GLO=GLO_")" "RTN","RCDPESP",279,0) .F S GLO=$Q(@GLO) Q:GLO'[GLB D MES^XPDUTL(" "_GLO_" = "_$G(@GLO)) "RTN","RCDPESP",280,0) .D MES^XPDUTL(" ") "RTN","RCDPESP",281,0) Q "RTN","RCDPESP",282,0) ; "RTN","RCDPESP",283,0) AUDIT(INP) ; WRITE AUDIT RECORD(S) "RTN","RCDPESP",284,0) ; INP = audit value in this format: "RTN","RCDPESP",285,0) ; FILE NUMBER^FIELD NUMBER^IEN^NEW VALUE^OLD VALUE^COMMENT "RTN","RCDPESP",286,0) Q:'$O(INP(0)) ; nothing to audit "RTN","RCDPESP",287,0) N FDAUDT ; FileMan FDA array for audits "RTN","RCDPESP",288,0) N IDX S IDX=0 "RTN","RCDPESP",289,0) F S IDX=$O(INP(IDX)) Q:'IDX D "RTN","RCDPESP",290,0) . K FDAUDT "RTN","RCDPESP",291,0) . S FDAUDT(344.7,"+1,",.01)=$$NOW^XLFDT "RTN","RCDPESP",292,0) . S FDAUDT(344.7,"+1,",.02)=$P(INP(IDX),U,3) ; IEN "RTN","RCDPESP",293,0) . S FDAUDT(344.7,"+1,",.03)=DUZ ; user "RTN","RCDPESP",294,0) . S FDAUDT(344.7,"+1,",.04)=$P(INP(IDX),U,2) ; FIELD NUMBER "RTN","RCDPESP",295,0) . S FDAUDT(344.7,"+1,",.05)=$P(INP(IDX),U,1) ; FILE NUMBER "RTN","RCDPESP",296,0) . S FDAUDT(344.7,"+1,",.06)=$P(INP(IDX),U,4) ; NEW VALUE "RTN","RCDPESP",297,0) . S FDAUDT(344.7,"+1,",.07)=$P(INP(IDX),U,5) ; OLD VALUE "RTN","RCDPESP",298,0) . S FDAUDT(344.7,"+1,",.08)=$P(INP(IDX),U,6) ; COMMENT "RTN","RCDPESP",299,0) . D UPDATE^DIE(,"FDAUDT") "RTN","RCDPESP",300,0) Q "RTN","RCDPESP",301,0) ; "RTN","RCDPESP",302,0) ; ************************************************************* "RTN","RCDPESP",303,0) ; CALLS RELATED TO CREATING EPAYMENT PAYER EXCLUSION PARAMETERS "RTN","RCDPESP",304,0) ; ************************************************************* "RTN","RCDPESP",305,0) ; "RTN","RCDPESP",306,0) NEWPYR ;Add new payers to payer table - called from AR Nightly Job (EN^RCDPEM) "RTN","RCDPESP",307,0) N RCDATE,RCERA,RCUPD "RTN","RCDPESP",308,0) ;Get date/time of last run otherwise start at previous day "RTN","RCDPESP",309,0) S RCDATE=$P($G(^RCY(344.61,1,0)),U,8) S:RCDATE="" RCDATE=$$FMADD^XLFDT($$NOW^XLFDT\1,-1) "RTN","RCDPESP",310,0) F S RCDATE=$O(^RCY(344.4,"AFD",RCDATE)) Q:'RCDATE D "RTN","RCDPESP",311,0) .S RCERA="" F S RCERA=$O(^RCY(344.4,"AFD",RCDATE,RCERA)) Q:'RCERA S RCUPD=$$PAYRINIT(RCERA) "RTN","RCDPESP",312,0) ;Update last run date "RTN","RCDPESP",313,0) S $P(^RCY(344.61,1,0),U,8)=$$NOW^XLFDT "RTN","RCDPESP",314,0) Q "RTN","RCDPESP",315,0) ; "RTN","RCDPESP",316,0) PAYERPRM(IEN,EXMDPOST,EXMDDECR) ; USED TO UPDATE A NEW PAYER "RTN","RCDPESP",317,0) ; CHECK IEN FOR VALID INPUT "RTN","RCDPESP",318,0) Q:'$G(IEN)!('$D(^RCY(344.4,+$G(IEN),0))) 0 "RTN","RCDPESP",319,0) N PFDA,PAYER,ID,CPAYERID,PIENS "RTN","RCDPESP",320,0) S PAYER=$E($$GET1^DIQ(344.4,IEN_",",.06),1,35) "RTN","RCDPESP",321,0) Q:PAYER="" 0 "RTN","RCDPESP",322,0) S ID=$E($$GET1^DIQ(344.4,IEN_",",.03),1,30) "RTN","RCDPESP",323,0) I '$D(^RCY(344.6,"CPID",PAYER,ID)) Q 0 "RTN","RCDPESP",324,0) ; FILE CURRENT SETTINGS "RTN","RCDPESP",325,0) S PIENS=$O(^RCY(344.6,"CPID",PAYER,ID,0))_"," "RTN","RCDPESP",326,0) S PFDA(344.6,PIENS,.04)=DUZ "RTN","RCDPESP",327,0) S PFDA(344.6,PIENS,.05)=$$NOW^XLFDT "RTN","RCDPESP",328,0) S PFDA(344.6,PIENS,.06)=+$G(EXMDPOST) "RTN","RCDPESP",329,0) S PFDA(344.6,PIENS,.07)=+$G(EXMDDECR) "RTN","RCDPESP",330,0) D FILE^DIE(,"PFDA") "RTN","RCDPESP",331,0) Q 1 "RTN","RCDPESP",332,0) ; "RTN","RCDPESP",333,0) PAYRINIT(IEN) ; Add Payer Name and Payer ID to Payer table #344.6 "RTN","RCDPESP",334,0) ; "RTN","RCDPESP",335,0) N PFDA,PAYER,ID,PIENS,ERADATE "RTN","RCDPESP",336,0) ; "RTN","RCDPESP",337,0) Q:'$G(IEN)!('$D(^RCY(344.4,+$G(IEN)))) 0 "RTN","RCDPESP",338,0) S PAYER=$P($G(^RCY(344.4,IEN,0)),U,6) Q:PAYER="" 0 "RTN","RCDPESP",339,0) S ID=$P($G(^RCY(344.4,IEN,0)),U,3) Q:ID="" 0 "RTN","RCDPESP",340,0) I $D(^RCY(344.6,"CPID",PAYER,ID)) Q 1 "RTN","RCDPESP",341,0) S ERADATE=$P($G(^RCY(344.4,IEN,0)),U,7) "RTN","RCDPESP",342,0) ; UPDATE PAYER PARAMETERS "RTN","RCDPESP",343,0) S PIENS="+1," "RTN","RCDPESP",344,0) S PFDA(344.6,PIENS,.01)=PAYER "RTN","RCDPESP",345,0) S PFDA(344.6,PIENS,.02)=ID "RTN","RCDPESP",346,0) S PFDA(344.6,PIENS,.03)=ERADATE "RTN","RCDPESP",347,0) S PFDA(344.6,PIENS,.04)=.5 "RTN","RCDPESP",348,0) S PFDA(344.6,PIENS,.05)=$$NOW^XLFDT "RTN","RCDPESP",349,0) S PFDA(344.6,PIENS,.06)=0 "RTN","RCDPESP",350,0) S PFDA(344.6,PIENS,.07)=0 "RTN","RCDPESP",351,0) D UPDATE^DIE(,"PFDA") "RTN","RCDPESP",352,0) Q 1 "RTN","RCDPESP",353,0) ; "RTN","RCDPESP1") 0^21^B113871339 "RTN","RCDPESP1",1,0) RCDPESP1 ;BIRM/SAB,hrubovcak - ePayment Lockbox Site Parameter Reports ;27 Nov 2018 09:10:16 "RTN","RCDPESP1",2,0) ;;4.5;Accounts Receivable;**298,304,318,321,326,332**;Mar 20, 1995;Build 40 "RTN","RCDPESP1",3,0) ;Per VA Directive 6402, this routine should not be modified. "RTN","RCDPESP1",4,0) ; "RTN","RCDPESP1",5,0) Q "RTN","RCDPESP1",6,0) ; "RTN","RCDPESP1",7,0) RPT ; EDI Lockbox Parameters Report [RCDPE SITE PARAMETER REPORT] "RTN","RCDPESP1",8,0) ; report data from: "RTN","RCDPESP1",9,0) ; AR SITE PARAMETER file (#342) "RTN","RCDPESP1",10,0) ; RCDPE PARAMETER file (#344.61) "RTN","RCDPESP1",11,0) ; RCDPE AUTO-PAY EXCLUSION file (#344.6) "RTN","RCDPESP1",12,0) ; "RTN","RCDPESP1",13,0) ; LOCAL VARIABLES: "RTN","RCDPESP1",14,0) ; RTYPE - Type of Report to run (Medical, Pharmacy, or Both) "RTN","RCDPESP1",15,0) ; "RTN","RCDPESP1",16,0) N RCTYPE "RTN","RCDPESP1",17,0) W !,$$HDRLN,! "RTN","RCDPESP1",18,0) ; "RTN","RCDPESP1",19,0) S RCTYPE=$$RTYPE^RCDPESP2() G:RCTYPE=-1 RPTQ "RTN","RCDPESP1",20,0) W !! ;Spacing before the next prompt "RTN","RCDPESP1",21,0) ; "RTN","RCDPESP1",22,0) N %ZIS,POP S %ZIS="QM" D ^%ZIS Q:POP "RTN","RCDPESP1",23,0) I $D(IO("Q")) D Q "RTN","RCDPESP1",24,0) .N ZTDESC,ZTQUEUED,ZTRTN,ZTSAVE,ZTSK "RTN","RCDPESP1",25,0) .S ZTRTN="SPRPT^RCDPESP1",ZTDESC=$$HDRLN,ZTSAVE("RC*")="" "RTN","RCDPESP1",26,0) .D ^%ZTLOAD "RTN","RCDPESP1",27,0) .W !!,$S($G(ZTSK):"Task number "_ZTSK_" has been queued.",1:"Unable to queue this task.") "RTN","RCDPESP1",28,0) .K IO("Q") D HOME^%ZIS "RTN","RCDPESP1",29,0) ; "RTN","RCDPESP1",30,0) D SPRPT "RTN","RCDPESP1",31,0) RPTQ Q "RTN","RCDPESP1",32,0) ; "RTN","RCDPESP1",33,0) SPRPT ; site parameter report entry point "RTN","RCDPESP1",34,0) ; RCNTR - counter "RTN","RCDPESP1",35,0) ; RCFLD - DD field number "RTN","RCDPESP1",36,0) ; RCHDR - header information "RTN","RCDPESP1",37,0) ; RCPARM - parameters "RTN","RCDPESP1",38,0) ; RCSTOP - exit flag "RTN","RCDPESP1",39,0) N J,RCACTV,RCCARCD,RCCIEN,RCCODE,RCDATA,RCDESC,RCFLD,RCGLB,RCHDR,RCI,RCITEM,RCNTR,RCPARM,RCSTAT,RCSTOP,RCSTRING,V,X,Y "RTN","RCDPESP1",40,0) ; "RTN","RCDPESP1",41,0) S X="RC" F S X=$O(^TMP($J,X)) Q:'($E(X,1,2)="RC") K ^TMP($J,X) ; clear out old data "RTN","RCDPESP1",42,0) ; "RTN","RCDPESP1",43,0) ; RCGLB - ^TMP global storage locations "RTN","RCDPESP1",44,0) ; ^TMP($J,"RC342") - AR SITE PARAMETER file (#342) "RTN","RCDPESP1",45,0) ; ^TMP($J,"RC344.6") - RCDPE AUTO-PAY EXCLUSION file (#344.6) "RTN","RCDPESP1",46,0) ; ^TMP($J,"RC344.61") - RCDPE PARAMETER file (#344.61) "RTN","RCDPESP1",47,0) F J=342,344.6,344.61 S RCGLB(J)=$NA(^TMP($J,"RC"_J)) K @RCGLB(J) "RTN","RCDPESP1",48,0) ; "RTN","RCDPESP1",49,0) S RCHDR("RUNDATE")=$$FMTE^XLFDT($$NOW^XLFDT,"10S") "RTN","RCDPESP1",50,0) S RCHDR("PGNMBR")=0 ; page number "RTN","RCDPESP1",51,0) ; "RTN","RCDPESP1",52,0) ; AR SITE PARAMETER file (#342) "RTN","RCDPESP1",53,0) D GETS^DIQ(342,"1,",".01;7.02;7.03;7.04;7.05;7.06;7.07;7.08;7.09;","E",RCGLB(342)) "RTN","RCDPESP1",54,0) ; add site to header data "RTN","RCDPESP1",55,0) S RCHDR("SITE")="Site: "_@RCGLB(342)@(342,"1,",.01,"E") "RTN","RCDPESP1",56,0) ; "RTN","RCDPESP1",57,0) F RCFLD=7.02,7.03,7.04,7.05,7.06,7.07,7.08,7.09 S RCITEM=$S(RCFLD>7.04:"TITLE",1:"LABEL") D ; EFT and ERA days unmatched - PRCA*4.5*321 "RTN","RCDPESP1",58,0) . I RCTYPE="P",(RCFLD=7.05)!(RCFLD=7.07) Q ; Don't display if only showing Pharmacy parameters - PRCA*4.5*321 "RTN","RCDPESP1",59,0) . I RCTYPE="M",(RCFLD=7.06)!(RCFLD=7.08) Q ; Don't display if only showing medical parameters - PRCA*4.5*321 "RTN","RCDPESP1",60,0) . S Y=$$GET1^DID(342,RCFLD,,RCITEM)_": "_@RCGLB(342)@(342,"1,",RCFLD,"E") "RTN","RCDPESP1",61,0) . I RCFLD=7.05 D AD2RPT(" ") "RTN","RCDPESP1",62,0) . I (RCFLD=7.06)&(RCTYPE="P") D AD2RPT(" ") "RTN","RCDPESP1",63,0) . D AD2RPT(Y) "RTN","RCDPESP1",64,0) ; "RTN","RCDPESP1",65,0) D AD2RPT(" ") "RTN","RCDPESP1",66,0) ; "RTN","RCDPESP1",67,0) ; Display Medical Parameters "RTN","RCDPESP1",68,0) ; RCDPE PARAMETER file (#344.61) "RTN","RCDPESP1",69,0) D GETS^DIQ(344.61,"1,",".02;.03;.04;.05;.06;.07;.1;.11;.12;.13;1.01;1.02","E",RCGLB(344.61)) ; PRCA*4.5*321/PRCA*4.5*326/PRCA*4.5*332 "RTN","RCDPESP1",70,0) ; "RTN","RCDPESP1",71,0) S Y=$$GET1^DID(344.61,.1,,"LABEL")_": "_@RCGLB(344.61)@(344.61,"1,",.1,"E") ; PRCA*4.5*321 "RTN","RCDPESP1",72,0) D AD2RPT(Y),AD2RPT(" ") ; PRCA*4.5*321 "RTN","RCDPESP1",73,0) ; "RTN","RCDPESP1",74,0) ; get auto-post and auto-decrease settings, save zero node "RTN","RCDPESP1",75,0) S X=$G(^RCY(344.61,1,0)),RCPARM("AUTO-POST")=$P(X,U,2),RCPARM("AUTO-DECREASE")=$P(X,U,3),RCPARM(344.61,0)=X "RTN","RCDPESP1",76,0) S RCPARM("RX AUTO-POST")=$P($G(^RCY(344.61,1,1)),U) "RTN","RCDPESP1",77,0) ; "RTN","RCDPESP1",78,0) ; RCDPE AUTO-PAY EXCLUSION file (#344.6) "RTN","RCDPESP1",79,0) ; screening logic: ^DD(344.6,.06,0)="EXCLUDE MED CLAIMS POSTING^S^0:No;1:Yes;^0;6^Q" "RTN","RCDPESP1",80,0) D LIST^DIC(344.6,,"@;.01;.02;.06;1","P",,,,,"I $P(^(0),U,6)=1",,RCGLB(344.6)) "RTN","RCDPESP1",81,0) ; "RTN","RCDPESP1",82,0) ; PRCA*4.5*304 - Print Medical Claim Parameters "RTN","RCDPESP1",83,0) I RCTYPE'="P" D "RTN","RCDPESP1",84,0) .; RCDPE PARAMETER file (#344.61), auto-posting of medical claims "RTN","RCDPESP1",85,0) .S X=$$GET1^DID(344.61,.02,,"TITLE"),V=" (Y/N)" S:X[V X=$P(X,V)_$P(X,V,2) ; remove yes/no prompt "RTN","RCDPESP1",86,0) .S Y=X_" "_@RCGLB(344.61)@(344.61,"1,",.02,"E") "RTN","RCDPESP1",87,0) .D AD2RPT(Y) "RTN","RCDPESP1",88,0) .I (RCPARM("AUTO-POST")!RCPARM("AUTO-DECREASE")) D ; list auto-post excluded payers "RTN","RCDPESP1",89,0) ..I '$D(@RCGLB(344.6)@("DILIST",1,0)) D Q "RTN","RCDPESP1",90,0) ...S X=" No payers excluded from medical auto-posting." D AD2RPT($J(" ",80-$L(X)\2)_X) "RTN","RCDPESP1",91,0) ..; "RTN","RCDPESP1",92,0) ..D AD2RPT(" Excluded Payer Comment") "RTN","RCDPESP1",93,0) ..S RCNTR=0 "RTN","RCDPESP1",94,0) ..F S RCNTR=$O(@RCGLB(344.6)@("DILIST",RCNTR)) Q:'RCNTR D "RTN","RCDPESP1",95,0) ...S V=@RCGLB(344.6)@("DILIST",RCNTR,0),X=$E($P(V,U,2),1,35) "RTN","RCDPESP1",96,0) ...S Y=" "_X_$J(" ",36-$L(X))_$P(V,U,5) "RTN","RCDPESP1",97,0) ...D AD2RPT($E(Y,1,IOM)) "RTN","RCDPESP1",98,0) .; "RTN","RCDPESP1",99,0) .I RCPARM("AUTO-POST") D AD2RPT(" ") "RTN","RCDPESP1",100,0) .; "RTN","RCDPESP1",101,0) .K @RCGLB(344.6) ; delete old data "RTN","RCDPESP1",102,0) .; RCDPE AUTO-PAY EXCLUSION file (#344.6) "RTN","RCDPESP1",103,0) .; screening logic: ^DD(344.6,.07,0)="EXCLUDE MED CLAIMS DECREASE^S^0:No;1:Yes;^0;7^Q" "RTN","RCDPESP1",104,0) .D LIST^DIC(344.6,,"@;.01;.02;.07;2","P",,,,,"I $P(^(0),U,7)=1",,RCGLB(344.6)) "RTN","RCDPESP1",105,0) .; "RTN","RCDPESP1",106,0) .; BEGIN PRCA*4.5*326 "RTN","RCDPESP1",107,0) .D AD2RPT(" ") "RTN","RCDPESP1",108,0) .; Display Auto-Decrease parameters for paid lines "RTN","RCDPESP1",109,0) .D AUTOD(1,.RCGBL,RCTYPE) "RTN","RCDPESP1",110,0) .; Display Auto-Decrease parameters for no-pay lines "RTN","RCDPESP1",111,0) .D AUTOD(0,.RCGBL,RCTYPE) "RTN","RCDPESP1",112,0) .D AD2RPT(" ") "RTN","RCDPESP1",113,0) .; END PRCA*4.5*326 "RTN","RCDPESP1",114,0) .I (RCPARM("AUTO-POST")!RCPARM("AUTO-DECREASE")) D ; list excluded auto-decrease payers "RTN","RCDPESP1",115,0) .. Q:'RCPARM("AUTO-DECREASE") "RTN","RCDPESP1",116,0) .. D AD2RPT(" All payers excluded from Auto-Posting are excluded from Auto-Decrease.") "RTN","RCDPESP1",117,0) .. I '$D(@RCGLB(344.6)@("DILIST",1,0)) D Q "RTN","RCDPESP1",118,0) ... S X=" No additional payers excluded from Medical Auto-Decrease." D AD2RPT($J(" ",80-$L(X)\2)_X) "RTN","RCDPESP1",119,0) ..; "RTN","RCDPESP1",120,0) .. D AD2RPT(" Additional Excluded Payer Comment") "RTN","RCDPESP1",121,0) .. S RCNTR=0 "RTN","RCDPESP1",122,0) .. F S RCNTR=$O(@RCGLB(344.6)@("DILIST",RCNTR)) Q:'RCNTR D "RTN","RCDPESP1",123,0) ... S V=@RCGLB(344.6)@("DILIST",RCNTR,0),X=$E($P(V,U,2),1,35) "RTN","RCDPESP1",124,0) ... S Y=" "_X_$J(" ",36-$L(X))_$P(V,U,5) "RTN","RCDPESP1",125,0) ... D AD2RPT($E(Y,1,IOM)) "RTN","RCDPESP1",126,0) .; "RTN","RCDPESP1",127,0) .D AD2RPT(" ") "RTN","RCDPESP1",128,0) ; "RTN","RCDPESP1",129,0) K @RCGLB(344.6) ; delete old data "RTN","RCDPESP1",130,0) ; RCDPE AUTO-PAY EXCLUSION file (#344.6) "RTN","RCDPESP1",131,0) ; screening logic: ^DD(344.6,.06,0)="EXCLUDE MED CLAIMS POSTING^S^0:No;1:Yes;^0;6^Q" "RTN","RCDPESP1",132,0) D LIST^DIC(344.6,,"@;.01;.02;.08;3","P",,,,,"I $P(^(0),U,8)=1",,RCGLB(344.6)) "RTN","RCDPESP1",133,0) ; "RTN","RCDPESP1",134,0) ; PRCA*4.5*304 - Print Pharmacy Claim Parameters "RTN","RCDPESP1",135,0) I RCTYPE'="M" D "RTN","RCDPESP1",136,0) .; RCDPE PARAMETER file (#344.61), auto-posting of pharmacy claims "RTN","RCDPESP1",137,0) .S X=$$GET1^DID(344.61,1.01,,"TITLE"),V=" (Y/N)" S:X[V X=$P(X,V)_$P(X,V,2) ; remove yes/no prompt "RTN","RCDPESP1",138,0) .S Y=X_" "_@RCGLB(344.61)@(344.61,"1,",1.01,"E") "RTN","RCDPESP1",139,0) .D AD2RPT(Y) "RTN","RCDPESP1",140,0) .; "RTN","RCDPESP1",141,0) . I RCPARM("RX AUTO-POST") D ; list auto-post excluded payers "RTN","RCDPESP1",142,0) .. I '$D(@RCGLB(344.6)@("DILIST",1,0)) D Q "RTN","RCDPESP1",143,0) ... S X=" No payers excluded from pharmacy auto-posting." D AD2RPT($J(" ",80-$L(X)\2)_X) "RTN","RCDPESP1",144,0) ..; "RTN","RCDPESP1",145,0) .. D AD2RPT(" Excluded Payer Comment") "RTN","RCDPESP1",146,0) .. S RCNTR=0 "RTN","RCDPESP1",147,0) .. F S RCNTR=$O(@RCGLB(344.6)@("DILIST",RCNTR)) Q:'RCNTR D "RTN","RCDPESP1",148,0) ... S V=@RCGLB(344.6)@("DILIST",RCNTR,0),X=$E($P(V,U,2),1,35) "RTN","RCDPESP1",149,0) ... S Y=" "_X_$J(" ",36-$L(X))_$P(V,U,5) "RTN","RCDPESP1",150,0) ... D AD2RPT($E(Y,1,IOM)) "RTN","RCDPESP1",151,0) .. S X=$P($$GET1^DID(344.61,1.02,,"TITLE")," (",1)_": " ; remove yes/no prompt "RTN","RCDPESP1",152,0) .. S Y=" "_X_" "_$S(@RCGLB(344.61)@(344.61,"1,",1.02,"E")="":"No",1:@RCGLB(344.61)@(344.61,"1,",1.02,"E")) "RTN","RCDPESP1",153,0) .. D AD2RPT(" "),AD2RPT(Y) "RTN","RCDPESP1",154,0) .; "RTN","RCDPESP1",155,0) .I RCPARM("RX AUTO-POST") D AD2RPT(" ") "RTN","RCDPESP1",156,0) .; "RTN","RCDPESP1",157,0) .K @RCGLB(344.6) ; delete old data "RTN","RCDPESP1",158,0) .; "RTN","RCDPESP1",159,0) .; PRCA*4.5*304 - Print the CARC Auto-decrease parameters "RTN","RCDPESP1",160,0) . I $$CARCCHK(RCTYPE,"P") D "RTN","RCDPESP1",161,0) .. S RCSTRING=$TR($J("",73)," ","-"),RCI=0 "RTN","RCDPESP1",162,0) .. D AD2RPT(" CARC Description Max. Amt") "RTN","RCDPESP1",163,0) .. D AD2RPT(RCSTRING) "RTN","RCDPESP1",164,0) .. ; "RTN","RCDPESP1",165,0) .. ; Loop and print entries "RTN","RCDPESP1",166,0) .. F S RCI=$O(^RCY(344.62,RCI)) Q:'RCI D "RTN","RCDPESP1",167,0) ... S RCDATA=$G(^RCY(344.62,RCI,0)),Y="" "RTN","RCDPESP1",168,0) ... Q:RCDATA="" "RTN","RCDPESP1",169,0) ... S RCCODE=$P(RCDATA,U),RCCIEN=$O(^RC(345,"B",RCCODE,"")) "RTN","RCDPESP1",170,0) ... S RCDESC=$G(^RC(345,RCCIEN,1,1,0)) "RTN","RCDPESP1",171,0) ... S RCSTAT=$P(RCDATA,U,2) "RTN","RCDPESP1",172,0) ... Q:RCSTAT'=1 "RTN","RCDPESP1",173,0) ... I $L(RCDESC)>50 S RCDESC=$E(RCDESC,1,50)_" ..." "RTN","RCDPESP1",174,0) ... D GETCODES^RCDPCRR(RCCODE,"","A",$$DT^XLFDT,"RCCARCD","1^70") "RTN","RCDPESP1",175,0) ... S Y=" "_$E(RCCODE,1,4)_" " "RTN","RCDPESP1",176,0) ... S Y=Y_$E(RCDESC,1,55)_$J($P(RCDATA,U,6),10,0) "RTN","RCDPESP1",177,0) ... I '$$ACT^RCDPRU(345,RCCODE,) S Y=Y_" (I)" ; if inactive, display (i) "RTN","RCDPESP1",178,0) ... D AD2RPT(Y) "RTN","RCDPESP1",179,0) ; "RTN","RCDPESP1",180,0) ; RCDPE PARAMETER file (#344.61) "RTN","RCDPESP1",181,0) ; ^DD(344.61,.06,0) > "MEDICAL EFT POST PREVENT DAYS" "RTN","RCDPESP1",182,0) ; ^DD(344.61,.07,0) > "PHARMACY EFT POST PREVENT DAYS" "RTN","RCDPESP1",183,0) ; ^DD(344.61,.13,0) > "TRICARE EFT POST PREVENT DAYS" "RTN","RCDPESP1",184,0) F RCFLD=.06,.07,.13 D "RTN","RCDPESP1",185,0) . Q:(RCFLD=.06)&(RCTYPE="P") ; Don't display if only showing Pharmacy parameters "RTN","RCDPESP1",186,0) . Q:(RCFLD=.07)&(RCTYPE="M") ; Don't display if only showing medical parameters "RTN","RCDPESP1",187,0) . S Y=$$GET1^DID(344.61,RCFLD,,"TITLE")_" "_@RCGLB(344.61)@(344.61,"1,",RCFLD,"E") "RTN","RCDPESP1",188,0) . D AD2RPT(Y) "RTN","RCDPESP1",189,0) ; "RTN","RCDPESP1",190,0) D AD2RPT(" "),AD2RPT($$ENDORPRT^RCDPEARL) "RTN","RCDPESP1",191,0) ; "RTN","RCDPESP1",192,0) S RCSTOP=0 U IO D SPHDR(.RCHDR) "RTN","RCDPESP1",193,0) S J=0 F S J=$O(^TMP($J,"RC SP REPORT",J)) Q:'J!RCSTOP S Y=^TMP($J,"RC SP REPORT",J,0) D "RTN","RCDPESP1",194,0) .W !,Y Q:'$O(^TMP($J,"RC SP REPORT",J)) ; quit if last line "RTN","RCDPESP1",195,0) .I '$G(ZTSK),$E(IOST,1,2)="C-",$Y+3>IOSL D ASK^RCDPEARL(.RCSTOP) I 'RCSTOP D SPHDR(.RCHDR) Q "RTN","RCDPESP1",196,0) .Q:RCSTOP Q:$Y+250 S RCDESC=$E(RCDESC,1,50)_" ..." "RTN","RCDPESP1",293,0) . . D GETCODES^RCDPCRR(RCCODE,"","A",$$DT^XLFDT,"RCCARCD","1^70") "RTN","RCDPESP1",294,0) . . S Y=" "_$J(RCCODE,4)_" " "RTN","RCDPESP1",295,0) . . S Y=Y_$E(RCDESC,1,53) "RTN","RCDPESP1",296,0) . . S:$L(RCDESC)<53 Y=Y_$J("",(53-$L(RCDESC))) "RTN","RCDPESP1",297,0) . . S FIELD=$S(PAID:.06,1:.12) "RTN","RCDPESP1",298,0) . . S Y=Y_$J($$GET1^DIQ(344.62,RCI,FIELD,"I"),10,0) "RTN","RCDPESP1",299,0) . . I '$$ACT^RCDPRU(345,RCCODE,) S Y=Y_" (I)" ; if inactive, display (i) "RTN","RCDPESP1",300,0) . . D AD2RPT(Y) "RTN","RCDPESP1",301,0) . I CNT=0 D AD2RPT(" No CARCs are set up for "_$S(PAID:"",1:"NO-PAY ")_"auto-decrease") "RTN","RCDPESP1",302,0) ; "RTN","RCDPESP1",303,0) ; Display auto-decrease days "RTN","RCDPESP1",304,0) S FIELD=$S(PAID:.04,1:.12) "RTN","RCDPESP1",305,0) S X=$P($$GET1^DID(344.61,FIELD,,"TITLE")," (",1)_": " "RTN","RCDPESP1",306,0) S Y=$J(X,40)_@RCGLB(344.61)@(344.61,"1,",FIELD,"E") "RTN","RCDPESP1",307,0) D AD2RPT(" "),AD2RPT(Y) "RTN","RCDPESP1",308,0) Q "RTN","RCDPESP1",309,0) ; END - PRCA*4.5*326 "RTN","RCDPESP2") 0^26^B101041466 "RTN","RCDPESP2",1,0) RCDPESP2 ;BIRM/SAB - ePayment Lockbox Parameter Audit and Exclusion Reports ;17 Oct 2018 18:52:41 "RTN","RCDPESP2",2,0) ;;4.5;Accounts Receivable;**298,304,317,321,326,332**;Mar 20, 1995;Build 40 "RTN","RCDPESP2",3,0) ;Per VA Directive 6402, this routine should not be modified. "RTN","RCDPESP2",4,0) ; "RTN","RCDPESP2",5,0) Q "RTN","RCDPESP2",6,0) ; "RTN","RCDPESP2",7,0) RPT1 ; EDI Lockbox Parameters Report [RCDPE SITE PARAMETER REPORT] "RTN","RCDPESP2",8,0) G AUDPARM^RCDPESPA ; PRCA*4.5*332, report moved, 11 October 2018 "RTN","RCDPESP2",9,0) Q "RTN","RCDPESP2",10,0) ; "RTN","RCDPESP2",11,0) HDRLPR(RCEXCEL,RCHDR,RCSTOP) ; Report header Lockbox Parameter Report "RTN","RCDPESP2",12,0) ; RCEXCEL - if true output for Excel "RTN","RCDPESP2",13,0) ; RCHDR("PAGE") - page count, passed by ref. "RTN","RCDPESP2",14,0) ; RCSTOP - report exit flag "RTN","RCDPESP2",15,0) ; RCTYPE - Type of report to run "RTN","RCDPESP2",16,0) ; "RTN","RCDPESP2",17,0) N RCTYPED "RTN","RCDPESP2",18,0) S RCTYPED=$S(RCHDR("REPORTTYPE")="M":"MEDICAL",RCHDR("REPORTTYPE")="P":"PHARMACY",1:"ALL") "RTN","RCDPESP2",19,0) ; "RTN","RCDPESP2",20,0) I RCEXCEL D Q ; Excel header for PARAMETER AUDITS "RTN","RCDPESP2",21,0) .Q:RCHDR("PAGE") "RTN","RCDPESP2",22,0) .W !,"PARAMETER^DATE/TIME EDITED^OLD VALUE^NEW VALUE^USER" "RTN","RCDPESP2",23,0) .S RCHDR("PAGE")=1 ; only print once "RTN","RCDPESP2",24,0) ; "RTN","RCDPESP2",25,0) I 'RCEXCEL D "RTN","RCDPESP2",26,0) .I RCHDR("PAGE") D ASK^RCDPEARL(.RCSTOP) Q:RCSTOP "RTN","RCDPESP2",27,0) .W @IOF "RTN","RCDPESP2",28,0) .S RCHDR("PAGE")=RCHDR("PAGE")+1 "RTN","RCDPESP2",29,0) . W $$CNTR("EDI Lockbox Parameter Audit Report"),?IOM-8,"Page: "_RCHDR("PAGE") "RTN","RCDPESP2",30,0) . W !,$$CNTR("RUN DATE: "_RCHDR("RUNDATE")) "RTN","RCDPESP2",31,0) . W !,$$CNTR("DATE RANGE: "_RCHDR("DATERANGE")) "RTN","RCDPESP2",32,0) . W !,$$CNTR("REPORT TYPE: "_RCTYPED) "RTN","RCDPESP2",33,0) . W !!,"LOCKBOX PARAMETER UPDATES" "RTN","RCDPESP2",34,0) . W !,"------------------------- Values" "RTN","RCDPESP2",35,0) . W !,"Parameter Date/Time Edited Old New User" "RTN","RCDPESP2",36,0) . N I S $P(I,"=",IOM+1)="" W !,I "RTN","RCDPESP2",37,0) Q "RTN","RCDPESP2",38,0) ; "RTN","RCDPESP2",39,0) RPT2 ; EDI Lockbox Exclusion Audit Report [RCDPE EXCLUSION AUDIT REPORT] "RTN","RCDPESP2",40,0) ; "RTN","RCDPESP2",41,0) ; DESCRIPTION: This report is a simple listing of the RCDPE PARAMETER AUDIT file "RTN","RCDPESP2",42,0) ; including data concerning changes to the RCDPE AUTO-PAY EXCLUSION file. "RTN","RCDPESP2",43,0) ; "RTN","RCDPESP2",44,0) ; GLOBALS: ^RCY(344.7, RCDPE PARAMETER AUDIT "RTN","RCDPESP2",45,0) ; ^RCY(344.6, RCDPE AUTO-PAY EXCLUSION "RTN","RCDPESP2",46,0) ; ^TMP("RCDPESP2",$J, TMP FILE FOR LIST DIC OUTPUT "RTN","RCDPESP2",47,0) ; "RTN","RCDPESP2",48,0) ; INPUT PARAMETERS: NONE "RTN","RCDPESP2",49,0) ; "RTN","RCDPESP2",50,0) ; LOCAL VARIABLES: "RTN","RCDPESP2",51,0) ; RCRANGE - date range for report "RTN","RCDPESP2",52,0) ; RCSTDT - report start date "RTN","RCDPESP2",53,0) ; RCENDT - report end date "RTN","RCDPESP2",54,0) ; RCEXCEL - true if report in Excel format "RTN","RCDPESP2",55,0) ; RCSCR - screening logic for LIST^DIC "RTN","RCDPESP2",56,0) ; RCFLDS - fields for LIST^DIC "RTN","RCDPESP2",57,0) ; RCDIGET - storage for results from LIST^DIC "RTN","RCDPESP2",58,0) ; RCDIERR - errors from LIST^DIC "RTN","RCDPESP2",59,0) ; RCHDR("PAGE") - page counter "RTN","RCDPESP2",60,0) ; RCHDR("RUNDATE") - date/time report was run "RTN","RCDPESP2",61,0) ; RCSTOP - report exit flag "RTN","RCDPESP2",62,0) ; RCPARAM - parameter that was changed "RTN","RCDPESP2",63,0) ; RCPARAM("TIME") - time parameter changed "RTN","RCDPESP2",64,0) ; RCPARAM("OLDVAL") - old parameter value "RTN","RCDPESP2",65,0) ; RCPARAM("NEWVAL") - new parameter value "RTN","RCDPESP2",66,0) ; RCPARAM("USER") - USER WHO CHANGED A PARAMETER "RTN","RCDPESP2",67,0) ; RCTMP - one record from LIST^DIC "RTN","RCDPESP2",68,0) ; RCFND - flag indicating records returned "RTN","RCDPESP2",69,0) ; RCTYPE - TYPE OF REPORT TO RUN (MEDICAL, PHARMACY, OR BOTH) "RTN","RCDPESP2",70,0) ; "RTN","RCDPESP2",71,0) W !!," EDI Lockbox Exclusion Audit Report",! "RTN","RCDPESP2",72,0) ; "RTN","RCDPESP2",73,0) N RCENDT,RCEXCEL,RCFLDS,RCFND,RCDIGET,RCHDR,RCIEN,RCDIERR,RCPARAM,RCRANGE,RCSCR,RCSTDT,RCSTOP,RCTMP,RCTYPE,RCSCRTYP,RCDIMED,RCDIRX "RTN","RCDPESP2",74,0) ; Kernel variables "RTN","RCDPESP2",75,0) N X1,X2,X,Y,%ZIS,POP "RTN","RCDPESP2",76,0) ; initialize values "RTN","RCDPESP2",77,0) S (RCHDR("PAGE"),RCSTOP,RCIEN,RCEXCEL,RCFND)=0 "RTN","RCDPESP2",78,0) S RCDIGET=$NA(^TMP("RCDPESP2",$J)) K @RCDIGET "RTN","RCDPESP2",79,0) ; PRCA*4.5*304 - Medical and RX audit entries "RTN","RCDPESP2",80,0) S RCDIMED=$NA(^TMP("RCDPESP2-MED",$J)) K @RCDIMED "RTN","RCDPESP2",81,0) S RCDIRX=$NA(^TMP("RCDPESP2-RX",$J)) K @RCDIRX "RTN","RCDPESP2",82,0) ; "RTN","RCDPESP2",83,0) S RCTYPE=$$RTYPE() "RTN","RCDPESP2",84,0) Q:RCTYPE=-1 "RTN","RCDPESP2",85,0) S RCHDR("REPORTTYPE")=RCTYPE "RTN","RCDPESP2",86,0) ; "RTN","RCDPESP2",87,0) ; GET DATE RANGES "RTN","RCDPESP2",88,0) S RCRANGE=$$DTRNG() "RTN","RCDPESP2",89,0) Q:RCRANGE=0 "RTN","RCDPESP2",90,0) S RCSTDT=$P(RCRANGE,U,2)-.0000001,RCENDT=$P(RCRANGE,U,3)+.9999999 "RTN","RCDPESP2",91,0) ; "RTN","RCDPESP2",92,0) ; output fields for LIST^DIC "RTN","RCDPESP2",93,0) S RCFLDS="@;.04;.01I;.06;.03;.08;.02" "RTN","RCDPESP2",94,0) ; .04 - CHANGED FIELD .01 - TIMESTAMP .06 - NEW VALUE "RTN","RCDPESP2",95,0) ; .03 - CHANGED BY .08 - COMMENT .02 - MODIFIED IEN "RTN","RCDPESP2",96,0) ; "RTN","RCDPESP2",97,0) ; first part of LIST^DIC screening logic "RTN","RCDPESP2",98,0) S RCSCR="I ($P(^(0),U,5)=344.6)&($P(^(0),U,1)>"_RCSTDT_")&($P(^(0),U,1)<"_RCENDT_")" "RTN","RCDPESP2",99,0) ; "RTN","RCDPESP2",100,0) ; OUTPUT TO EXCEL? "RTN","RCDPESP2",101,0) S RCEXCEL=$$DISPTY^RCDPEM3() Q:+RCEXCEL=-1 "RTN","RCDPESP2",102,0) I RCEXCEL D INFO^RCDPEM6 "RTN","RCDPESP2",103,0) ; "RTN","RCDPESP2",104,0) ;Select output device "RTN","RCDPESP2",105,0) S %ZIS="M" D ^%ZIS Q:POP U IO "RTN","RCDPESP2",106,0) ; "RTN","RCDPESP2",107,0) S RCHDR("RUNDATE")=$$FMTE^XLFDT($$NOW^XLFDT,"5S") "RTN","RCDPESP2",108,0) ; "RTN","RCDPESP2",109,0) ; PROCESS AUTO-POST EXCLUSIONS "RTN","RCDPESP2",110,0) ; "RTN","RCDPESP2",111,0) ; PRCA*4.5*304 - Get the correct screening logic, based on the type of audit reeport to run "RTN","RCDPESP2",112,0) S RCSCR(.06)=RCSCR_"&($P(^(0),U,4)=.06)" ; screening logic for medical auto-post "RTN","RCDPESP2",113,0) S RCSCR(.07)=RCSCR_"&($P(^(0),U,4)=.07)" ; screening logic for medical auto-decrease "RTN","RCDPESP2",114,0) S RCSCR(.08)=RCSCR_"&($P(^(0),U,4)=.08)" ; screening logic for pharmacy auto-post "RTN","RCDPESP2",115,0) ; "RTN","RCDPESP2",116,0) ;PRCA*4.5*304 - Get the medical and RX audit entries for Auto-Post exclusions "RTN","RCDPESP2",117,0) D LIST^DIC(344.7,,RCFLDS,"P",,,,,RCSCR(.06),,RCDIMED,"RCDIERR") "RTN","RCDPESP2",118,0) ; CHECK FOR AN ERROR "RTN","RCDPESP2",119,0) I $D(RCDIERR) W !!,"Error collecting auto-post report data." D ASK^RCDPEARL(.RCSTOP) Q "RTN","RCDPESP2",120,0) ; "RTN","RCDPESP2",121,0) ; Get the correct screening logic, based on the type of audit to run "RTN","RCDPESP2",122,0) D LIST^DIC(344.7,,RCFLDS,"P",,,,,RCSCR(.07),,RCDIGET,"RCDIERR") "RTN","RCDPESP2",123,0) ; "RTN","RCDPESP2",124,0) ; CHECK FOR AN ERROR "RTN","RCDPESP2",125,0) I $D(RCDIERR) W !!,"Error collecting auto-decrease report data." D ASK^RCDPEARL(.RCSTOP) Q "RTN","RCDPESP2",126,0) ; "RTN","RCDPESP2",127,0) D LIST^DIC(344.7,,RCFLDS,"P",,,,,RCSCR(.08),,RCDIRX,"RCDIERR") "RTN","RCDPESP2",128,0) ; CHECK FOR AN ERROR "RTN","RCDPESP2",129,0) I $D(RCDIERR) W !!,"Error collecting auto-post report data." D ASK^RCDPEARL(.RCSTOP) Q "RTN","RCDPESP2",130,0) ; "RTN","RCDPESP2",131,0) I (RCTYPE="B")!(RCTYPE="M") D G:RCSTOP RPT2Q "RTN","RCDPESP2",132,0) . D HDRXAR(.06,RCTYPE) ; complete header "RTN","RCDPESP2",133,0) . ; "RTN","RCDPESP2",134,0) . S RCFND=$D(@RCDIMED@("DILIST",1)) ; CHECK FOR RECORDS RETURNED "RTN","RCDPESP2",135,0) . I 'RCFND W !,"No Auto-post Exclusions to Display",! "RTN","RCDPESP2",136,0) . ; "RTN","RCDPESP2",137,0) . I RCFND S RCIEN=0 D "RTN","RCDPESP2",138,0) .. F S RCIEN=$O(@RCDIMED@("DILIST",RCIEN)) Q:RCSTOP!('RCIEN) D "RTN","RCDPESP2",139,0) ... S RCTMP=$P(@RCDIMED@("DILIST",RCIEN,0),U,2,7) "RTN","RCDPESP2",140,0) ... I 'RCEXCEL,$Y+4>IOSL D HDRXAR(.06,RCTYPE) Q:RCSTOP "RTN","RCDPESP2",141,0) ... D DSPXCLSN(RCTMP) "RTN","RCDPESP2",142,0) . ; PROCESS MEDICAL AUTO-DECREASE EXCLUSIONS "RTN","RCDPESP2",143,0) . D ; complete header or just the section "RTN","RCDPESP2",144,0) .. I $Y+11IOSL D HDRXAR(.07,RCTYPE) Q:RCSTOP "RTN","RCDPESP2",153,0) .. D DSPXCLSN(RCTMP) "RTN","RCDPESP2",154,0) ; "RTN","RCDPESP2",155,0) I (RCTYPE="B")!(RCTYPE="P") D G:RCSTOP RPT2Q "RTN","RCDPESP2",156,0) . I RCTYPE="P" D HDRXAR(.08,RCTYPE) ; complete header "RTN","RCDPESP2",157,0) . I RCTYPE'="P" D ; complete header or just the section "RTN","RCDPESP2",158,0) .. I $Y+11IOSL D HDRXAR(.08,RCTYPE) Q:RCSTOP "RTN","RCDPESP2",167,0) .. D DSPXCLSN(RCTMP) "RTN","RCDPESP2",168,0) ; "RTN","RCDPESP2",169,0) ; end of report "RTN","RCDPESP2",170,0) W !!,$$ENDORPRT^RCDPEARL "RTN","RCDPESP2",171,0) D ASK^RCDPEARL(.RCSTOP) "RTN","RCDPESP2",172,0) ; "RTN","RCDPESP2",173,0) RPT2Q ; "RTN","RCDPESP2",174,0) K @RCDIGET,@RCDIMED,@RCDIRX ; clean up "RTN","RCDPESP2",175,0) Q "RTN","RCDPESP2",176,0) ; "RTN","RCDPESP2",177,0) GETPAYER() ; GET THE PAYER NAME + PAYER ID "RTN","RCDPESP2",178,0) N RCIEN,RCPAYR "RTN","RCDPESP2",179,0) S RCIEN=$P(RCTMP,U,6) "RTN","RCDPESP2",180,0) I '$D(^RCY(344.6,RCIEN)) Q "" "RTN","RCDPESP2",181,0) S RCPAYR=$$GET1^DIQ(344.6,RCIEN_",",.01)_" "_$$GET1^DIQ(344.6,RCIEN_",",.02) "RTN","RCDPESP2",182,0) Q RCPAYR "RTN","RCDPESP2",183,0) ; "RTN","RCDPESP2",184,0) HDRXAR(RCTYP,RCTYPD) ; Report header for exclusin auto report "RTN","RCDPESP2",185,0) ; RCTYP - .06 = AUTO-POSTING EXCLUSION (medical) "RTN","RCDPESP2",186,0) ; .07 = AUTO-DECREASE EXCLUSION (medical) "RTN","RCDPESP2",187,0) ; .08 = AUTO-POSTING EXCLUSION (pharmacy) "RTN","RCDPESP2",188,0) ; RCTYPD - M = Medical "RTN","RCDPESP2",189,0) ; P = Pharmacy "RTN","RCDPESP2",190,0) ; B = Both "RTN","RCDPESP2",191,0) ; "RTN","RCDPESP2",192,0) N RCTYPED "RTN","RCDPESP2",193,0) S RCTYPED=$S(RCTYPD="M":"MEDICAL",RCTYPD="P":"PHARMACY",1:"ALL") "RTN","RCDPESP2",194,0) ; "RTN","RCDPESP2",195,0) I RCEXCEL D Q "RTN","RCDPESP2",196,0) .Q:RCHDR("PAGE") "RTN","RCDPESP2",197,0) .; Excel header for parameter audits "RTN","RCDPESP2",198,0) .W !!,"TYPE^CHANGE^PAYER^TIMESTAMP^USER^COMMENT" "RTN","RCDPESP2",199,0) .S RCHDR("PAGE")=1 ; only print it once "RTN","RCDPESP2",200,0) ; "RTN","RCDPESP2",201,0) I RCHDR("PAGE") D ASK^RCDPEARL(.RCSTOP) Q:RCSTOP "RTN","RCDPESP2",202,0) W @IOF "RTN","RCDPESP2",203,0) S RCHDR("PAGE")=RCHDR("PAGE")+1 "RTN","RCDPESP2",204,0) ; report header for parameter audits "RTN","RCDPESP2",205,0) W $$CNTR("EDI Lockbox Exclusion Audit Report"),?IOM-8,"Page: "_RCHDR("PAGE") "RTN","RCDPESP2",206,0) W !,$$CNTR("DIVISIONS: ALL") "RTN","RCDPESP2",207,0) W !,$$CNTR("RUN DATE: "_$G(RCHDR("RUNDATE"))) "RTN","RCDPESP2",208,0) W !,$$CNTR("DATE RANGE: "_$$FMTE^XLFDT($P(RCRANGE,U,2),"5D")_" - "_$$FMTE^XLFDT($P(RCRANGE,U,3),"5D")) "RTN","RCDPESP2",209,0) W !,$$CNTR("REPORT TYPE: "_RCTYPED) "RTN","RCDPESP2",210,0) D SECTHDR(RCTYP,RCTYPD) "RTN","RCDPESP2",211,0) Q "RTN","RCDPESP2",212,0) ; "RTN","RCDPESP2",213,0) SECTHDR(RCTYPE,RCREPT) ; SECTION HEADER "RTN","RCDPESP2",214,0) ; RCTYP - .06 = AUTO-POSTING EXCLUSION (medical) "RTN","RCDPESP2",215,0) ; .07 = AUTO-DECREASE EXCLUSION (medical) "RTN","RCDPESP2",216,0) ; .08 = AUTO-POSTING EXCLUSION (pharmacy) "RTN","RCDPESP2",217,0) ; RCREPT - "M" = "MEDICAL" "RTN","RCDPESP2",218,0) ; "P" = "PHARMACY" "RTN","RCDPESP2",219,0) Q:$G(RCEXCEL) "RTN","RCDPESP2",220,0) ; "RTN","RCDPESP2",221,0) I RCTYPE=.06 D "RTN","RCDPESP2",222,0) .W !!,"MEDICAL AUTO-POSTING PAYER EXCLUSION LIST" "RTN","RCDPESP2",223,0) .W !,"-----------------------------------------" "RTN","RCDPESP2",224,0) ; "RTN","RCDPESP2",225,0) I RCTYPE=.07 D "RTN","RCDPESP2",226,0) .W !!,"MEDICAL AUTO-DECREASE PAYER EXCLUSION LIST" "RTN","RCDPESP2",227,0) .W !,"------------------------------------------" "RTN","RCDPESP2",228,0) ; "RTN","RCDPESP2",229,0) I RCTYPE=.08 D "RTN","RCDPESP2",230,0) .W !!,"PHARMACY AUTO-POSTING PAYER EXCLUSION LIST" "RTN","RCDPESP2",231,0) .W !,"------------------------------------------" "RTN","RCDPESP2",232,0) ; "RTN","RCDPESP2",233,0) W !,"Change Payer Date/Time Edited User" "RTN","RCDPESP2",234,0) W !,$TR($J("",IOM-1)," ","=") ; row of equal signs "RTN","RCDPESP2",235,0) Q "RTN","RCDPESP2",236,0) ; "RTN","RCDPESP2",237,0) CNTR(TXT) ; center TXT "RTN","RCDPESP2",238,0) Q $J("",IOM-$L(TXT)\2)_TXT "RTN","RCDPESP2",239,0) ; "RTN","RCDPESP2",240,0) DTRNG() ; function, returns date range for the report "RTN","RCDPESP2",241,0) N DIR,DUOUT,RNGFLG,X,Y,RCSTART,RCEND "RTN","RCDPESP2",242,0) S (RCSTART,RCEND)=0 D DATES(.RCSTART,.RCEND) "RTN","RCDPESP2",243,0) Q:RCSTART=-1 0 "RTN","RCDPESP2",244,0) Q:RCSTART "1^"_RCSTART_"^"_RCEND "RTN","RCDPESP2",245,0) Q:'RCSTART "0^^" "RTN","RCDPESP2",246,0) Q 0 "RTN","RCDPESP2",247,0) ; "RTN","RCDPESP2",248,0) DATES(BDATE,EDATE) ; Get a date range, both values passed by ref. "RTN","RCDPESP2",249,0) N DIR,DTOUT,DUOUT,X,Y "RTN","RCDPESP2",250,0) S (BDATE,EDATE)=0 "RTN","RCDPESP2",251,0) S DIR("?")="Enter the earliest AUDIT DATE to include on the report" "RTN","RCDPESP2",252,0) S DIR(0)="DAO^:"_DT_":APE",DIR("A")="Report start date: " D ^DIR K DIR "RTN","RCDPESP2",253,0) I $D(DTOUT)!$D(DUOUT)!(Y="") S BDATE=-1 Q "RTN","RCDPESP2",254,0) S BDATE=Y K DIR,X,Y "RTN","RCDPESP2",255,0) S DIR("?")="Enter the latest AUDIT DATE to include on the report" "RTN","RCDPESP2",256,0) S DIR(0)="DAO^"_BDATE_":"_DT_":APE",DIR("A")="Report end date: ",DIR("B")=$$FMTE^XLFDT(DT) "RTN","RCDPESP2",257,0) D ^DIR K DIR "RTN","RCDPESP2",258,0) I $D(DTOUT)!$D(DUOUT)!(Y="") S BDATE=-1 Q "RTN","RCDPESP2",259,0) S EDATE=Y "RTN","RCDPESP2",260,0) Q "RTN","RCDPESP2",261,0) ; "RTN","RCDPESP2",262,0) DSPXCLSN(RCX) ; display exclusion "RTN","RCDPESP2",263,0) ; RCX - exclusion value from ^DIC call "RTN","RCDPESP2",264,0) N RCXCLSN "RTN","RCDPESP2",265,0) S RCXCLSN("CHANGE")=$S($P(RCX,U,3):"Added",1:"Removed") "RTN","RCDPESP2",266,0) S RCXCLSN("TIME")=$$FMTE^XLFDT($P(RCX,U,2),"2") "RTN","RCDPESP2",267,0) S RCXCLSN("USER")=$P(RCX,U,4) "RTN","RCDPESP2",268,0) S RCXCLSN("PAYER")=$$GETPAYER "RTN","RCDPESP2",269,0) S RCXCLSN("COMMENT")=$P(RCX,U,5) "RTN","RCDPESP2",270,0) ; "RTN","RCDPESP2",271,0) I 'RCEXCEL D Q "RTN","RCDPESP2",272,0) .N Y S Y=RCXCLSN("CHANGE"),$E(Y,9)=$E(RCXCLSN("PAYER"),1,30),$E(Y,41)=" "_RCXCLSN("TIME"),Y=Y_" "_RCXCLSN("USER") "RTN","RCDPESP2",273,0) .W !,Y,!," Comment: "_RCXCLSN("COMMENT") "RTN","RCDPESP2",274,0) ; Excel format "RTN","RCDPESP2",275,0) S RCXCLSN("LABEL")=$$GET1^DID(344.6,$P(RCX,U,1),,"LABEL") "RTN","RCDPESP2",276,0) W !,RCXCLSN("LABEL")_U_RCXCLSN("CHANGE")_U_RCXCLSN("PAYER")_U_RCXCLSN("TIME")_U_RCXCLSN("USER")_U_RCXCLSN("COMMENT") "RTN","RCDPESP2",277,0) ; "RTN","RCDPESP2",278,0) Q "RTN","RCDPESP2",279,0) ; "RTN","RCDPESP2",280,0) ;Retrieve the parameter for the type of information to display "RTN","RCDPESP2",281,0) RTYPE(DEF) ;EP from RCDPEAA1 "RTN","RCDPESP2",282,0) ; Input: DEF - Value to use a default "RTN","RCDPESP2",283,0) ; Returns: -1 - User ^ or timed out "RTN","RCDPESP2",284,0) ; M - User selected MEDICAL "RTN","RCDPESP2",285,0) ; P - User selected PHARMACY "RTN","RCDPESP2",286,0) ; B - User selected BOTH "RTN","RCDPESP2",287,0) N DA,DIR,DTOUT,DUOUT,X,Y,DIRUT,DIROUT,RCTYPE "RTN","RCDPESP2",288,0) S RCTYPE="" "RTN","RCDPESP2",289,0) S DIR("?")="Enter the type of information to display on the report" "RTN","RCDPESP2",290,0) S DIR(0)="SA^M:MEDICAL;P:PHARMACY;B:BOTH" "RTN","RCDPESP2",291,0) S DIR("A")="(M)EDICAL, (P)HARMACY, or (B)OTH: " ; PRCA*4.5*317 changed 'OR' to 'or' "RTN","RCDPESP2",292,0) S DIR("B")=$S($G(DEF)'="":DEF,1:"BOTH") "RTN","RCDPESP2",293,0) D ^DIR "RTN","RCDPESP2",294,0) K DIR "RTN","RCDPESP2",295,0) I $D(DTOUT)!$D(DUOUT) Q -1 "RTN","RCDPESP2",296,0) Q:Y="" "B" "RTN","RCDPESP2",297,0) Q $E(Y) "RTN","RCDPESP2",298,0) ; "RTN","RCDPESP2",299,0) ;Check to see if the Data element matches the report type "RTN","RCDPESP2",300,0) RPTYPE(RCTYPE,RCPARAM) ; "RTN","RCDPESP2",301,0) ; Return 1 if valid to print, 0 otherwise "RTN","RCDPESP2",302,0) N RCDATA,RCMEN,RCREN "RTN","RCDPESP2",303,0) ; "RTN","RCDPESP2",304,0) S (RCMEN,RCREN)="" "RTN","RCDPESP2",305,0) ; Get Auto Decrease parameters "RTN","RCDPESP2",306,0) I RCTYPE="M" S RCMEN=$P($G(^RCY(344.61,1,0)),U,3) "RTN","RCDPESP2",307,0) I RCTYPE="P" S RCREN=$P($G(^RCY(344.61,1,1)),U,2) "RTN","RCDPESP2",308,0) ; "RTN","RCDPESP2",309,0) Q:RCTYPE="B" 1 "RTN","RCDPESP2",310,0) Q:(RCTYPE="M")&(RCPARAM["MED") 1 ; Medical Parameters "RTN","RCDPESP2",311,0) Q:(RCTYPE="P")&(RCPARAM["RX") 1 ; Pharmacy parameters "RTN","RCDPESP2",312,0) Q:(RCTYPE="P")&(RCPARAM["PHARM") 1 ; Pharmacy parameters "RTN","RCDPESP2",313,0) Q:(RCTYPE="M")&(RCMEN)&(RCPARAM["DECREASE") 1 ; Auto-decrease for med is on "RTN","RCDPESP2",314,0) Q:(RCTYPE="P")&(RCREN)&(RCPARAM["DECREASE") 1 ; Auto-decrease for pharmacy "RTN","RCDPESP2",315,0) Q 0 "RTN","RCDPESP2",316,0) ; "RTN","RCDPESP5") 0^27^B268946794 "RTN","RCDPESP5",1,0) RCDPESP5 ;ALB/SAB - ePayment Lockbox Site Parameters Definition - Files 344.71 ;17 Oct 2018 18:52:41 "RTN","RCDPESP5",2,0) ;;4.5;Accounts Receivable;**304,321,326,332**;Mar 20, 1995;Build 40 "RTN","RCDPESP5",3,0) ;Per VA Directive 6402, this routine should not be modified. "RTN","RCDPESP5",4,0) ; "RTN","RCDPESP5",5,0) Q "RTN","RCDPESP5",6,0) ; "RTN","RCDPESP5",7,0) CARC(RCQUIT,PAID) ;Update the CARC/RARC inclusion table "RTN","RCDPESP5",8,0) ; INPUT RCQUIT - Added RCQUIT as input parameter - PRCA*4.5*321 "RTN","RCDPESP5",9,0) ; PAID 1 = payment lines 0 = no-payment lines - PRCA*4.5*326 "RTN","RCDPESP5",10,0) ;initialize "RTN","RCDPESP5",11,0) N RCANS,RCCARC,RCCHG,RCCDATA,RCCIEN,RCEDIT,RCRSN,RCSTAT "RTN","RCDPESP5",12,0) N RCAMT,RCNAMT,RCAUDARY,RCCARCDS,RCYN,RCVAL,RCINACT,RCACTV,RCTXT "RTN","RCDPESP5",13,0) S RCEDIT="",RCANS="" "RTN","RCDPESP5",14,0) ; "RTN","RCDPESP5",15,0) S RCTXT=$S(PAID:"",1:"NO-PAY ") ; PRCA*4.5*326 "RTN","RCDPESP5",16,0) ;Display initial entry line. "RTN","RCDPESP5",17,0) W !,"AUTO-DECREASE "_RCTXT_"MEDICAL CLAIMS FOR THE FOLLOWING CARC/AMOUNTS ONLY:",! "RTN","RCDPESP5",18,0) ; "RTN","RCDPESP5",19,0) ; "RTN","RCDPESP5",20,0) ;Loop until the user quits "RTN","RCDPESP5",21,0) F D Q:RCANS="Q" "RTN","RCDPESP5",22,0) . ; "RTN","RCDPESP5",23,0) . ;display list of currently enabled/disabled CARCs/RARCs "RTN","RCDPESP5",24,0) . D PRTCARC(PAID) ; PRCA*4.5*326 "RTN","RCDPESP5",25,0) . ; "RTN","RCDPESP5",26,0) . ; add some spacing "RTN","RCDPESP5",27,0) . W !! "RTN","RCDPESP5",28,0) . ; "RTN","RCDPESP5",29,0) . ;Ask user for the CARC/RARC to enable/disable (QUIT) [default] to exit "RTN","RCDPESP5",30,0) . ; "RTN","RCDPESP5",31,0) . S RCCARC=$$GETCARC() "RTN","RCDPESP5",32,0) . I RCCARC=-1 S RCQUIT=1,RCANS="Q" Q "RTN","RCDPESP5",33,0) . I RCCARC=0 S RCANS="Q" Q "RTN","RCDPESP5",34,0) . ; "RTN","RCDPESP5",35,0) . ;Validate CARC entered "RTN","RCDPESP5",36,0) . S RCVAL=$$VAL^RCDPCRR(345,RCCARC) ; Validate the CARC against File 345 "RTN","RCDPESP5",37,0) . S RCACTV=$$ACT^RCDPRU(345,RCCARC,) ; Check if CARC is an active code "RTN","RCDPESP5",38,0) . ; "RTN","RCDPESP5",39,0) . ;If the CARC is invalid, warn user and exit back to the CARC prompt "RTN","RCDPESP5",40,0) . I 'RCVAL W !,"The CARC code you have entered is not a valid CARC code. Please try again" Q "RTN","RCDPESP5",41,0) . ; "RTN","RCDPESP5",42,0) . ; Print CARC and description and initialize inactive variable "RTN","RCDPESP5",43,0) . S RCCARCDS="",RCINACT="" "RTN","RCDPESP5",44,0) . D GETCODES^RCDPCRR(RCCARC,"","A",$$DT^XLFDT,"RCCARCDS","1^70") "RTN","RCDPESP5",45,0) . I $D(RCCARCDS("CARC",RCCARC))'=10 D "RTN","RCDPESP5",46,0) . . S RCINACT=1 "RTN","RCDPESP5",47,0) . . D GETCODES^RCDPCRR(RCCARC,"","I",$$DT^XLFDT,"RCCARCDS","1^70") "RTN","RCDPESP5",48,0) . S RCCIEN=$O(RCCARCDS("CARC",RCCARC,"")) "RTN","RCDPESP5",49,0) . S RCDESC=$P(RCCARCDS("CARC",RCCARC,RCCIEN),U,6) "RTN","RCDPESP5",50,0) . ; "RTN","RCDPESP5",51,0) . ; If the description is 70 characters, add ellipsis to the string to indicate there is more to the description "RTN","RCDPESP5",52,0) . S:$E(RCDESC)=70 RCDESC=RCDESC_" ..." "RTN","RCDPESP5",53,0) . W !,?3,RCDESC,! "RTN","RCDPESP5",54,0) . I 'RCACTV W " *** WARNING: CARC code "_RCCARC_" is no longer active.",! "RTN","RCDPESP5",55,0) . ; "RTN","RCDPESP5",56,0) . ; Look up CARC/RARC in table. "RTN","RCDPESP5",57,0) . S RCCIEN=$O(^RCY(344.62,"B",RCCARC,"")) "RTN","RCDPESP5",58,0) . S (RCAMT,RCSTAT)=0 ; Initialize if new code entry for table "RTN","RCDPESP5",59,0) . I RCCIEN D ; Code exists in table "RTN","RCDPESP5",60,0) . . ; BEGIN - PRCA*4.5*326 "RTN","RCDPESP5",61,0) . . ; Get current payment Auto-decrease status and Max decrease amount "RTN","RCDPESP5",62,0) . . I PAID=1 D ; Payment lines "RTN","RCDPESP5",63,0) . . . S RCSTAT=$$GET1^DIQ(344.62,RCCIEN,.02,"I") "RTN","RCDPESP5",64,0) . . . S RCAMT=$$GET1^DIQ(344.62,RCCIEN,.06) "RTN","RCDPESP5",65,0) . . I PAID=0 D ; No payment lines "RTN","RCDPESP5",66,0) . . . S RCSTAT=$$GET1^DIQ(344.62,RCCIEN,.08,"I") "RTN","RCDPESP5",67,0) . . . S RCAMT=$$GET1^DIQ(344.62,RCCIEN,.12) "RTN","RCDPESP5",68,0) . . ; END - PRCA*4.5*326 "RTN","RCDPESP5",69,0) . ; "RTN","RCDPESP5",70,0) . ; Init Audit array to send each update individually "RTN","RCDPESP5",71,0) . S RCAUDARY(1)="" "RTN","RCDPESP5",72,0) . S RCAUDARY(2)="" "RTN","RCDPESP5",73,0) . ; "RTN","RCDPESP5",74,0) . ; If present and enabled "RTN","RCDPESP5",75,0) . I RCCIEN,RCSTAT D Q "RTN","RCDPESP5",76,0) . . ; "RTN","RCDPESP5",77,0) . . S RCNAMT=0,RCRSN="" ;Initialize variables "RTN","RCDPESP5",78,0) . . ; "RTN","RCDPESP5",79,0) . . ; Confirm that this is the correct CARC "RTN","RCDPESP5",80,0) . . S RCYN=$$CONFIRM(4,PAID) ; Added PAID - PRCA*4.5*326 "RTN","RCDPESP5",81,0) . . Q:RCYN=-1 "RTN","RCDPESP5",82,0) . . ; "RTN","RCDPESP5",83,0) . . ; Ask for reason "RTN","RCDPESP5",84,0) . . S RCRSN=$$GETREASN(RCCARC) "RTN","RCDPESP5",85,0) . . Q:RCRSN=-1 ; User requested to quit "RTN","RCDPESP5",86,0) . . ; "RTN","RCDPESP5",87,0) . . ; Confirm the disabling "RTN","RCDPESP5",88,0) . . S RCYN=$$CONFIRM(3,PAID) ; Added PAID - PRCA*4.5*326 "RTN","RCDPESP5",89,0) . . Q:RCYN=-1 "RTN","RCDPESP5",90,0) . . ; "RTN","RCDPESP5",91,0) . . D UPDDATA(RCCIEN,0,RCAMT,RCRSN,PAID) ; If disabling - PAID added PRCA*4.5*326 "RTN","RCDPESP5",92,0) . . ; "RTN","RCDPESP5",93,0) . . ;At least 1 item was change/updated/added so set flag for reprint "RTN","RCDPESP5",94,0) . . I 'RCEDIT S RCEDIT=1 "RTN","RCDPESP5",95,0) . . ; "RTN","RCDPESP5",96,0) . . ;Don't need a second entry in the audit file so kill it to prevent audit logging from crashing "RTN","RCDPESP5",97,0) . . K RCAUDARY(2) "RTN","RCDPESP5",98,0) . . ; "RTN","RCDPESP5",99,0) . . ; Update audit log for disable CARC "RTN","RCDPESP5",100,0) . . ; Order - File ; Field ; IEN ; New Value ; Old Value ; Comment "RTN","RCDPESP5",101,0) . . S FIELD=$S(PAID:.02,1:.08) ; PRCA*4.5*326 "RTN","RCDPESP5",102,0) . . S RCAUDARY(1)="344.62^"_FIELD_"^"_RCCIEN_"^0^1^"_RCRSN ; PRCA*4.5*326 "RTN","RCDPESP5",103,0) . . D AUDIT^RCDPESP(.RCAUDARY) "RTN","RCDPESP5",104,0) . ; "RTN","RCDPESP5",105,0) . ; Confirm that this is the correct CARC to Enable "RTN","RCDPESP5",106,0) . S RCYN=$$CONFIRM(1,PAID) ; Added PAID - PRCA*4.5*326 "RTN","RCDPESP5",107,0) . Q:RCYN=-1 "RTN","RCDPESP5",108,0) . ; "RTN","RCDPESP5",109,0) . ; Ask for new amount "RTN","RCDPESP5",110,0) . S RCNAMT=$$GETAMT() "RTN","RCDPESP5",111,0) . Q:RCNAMT=-1 ; User requested to quit "RTN","RCDPESP5",112,0) . ; "RTN","RCDPESP5",113,0) . ; Ask for reason "RTN","RCDPESP5",114,0) . S RCRSN=$$GETREASN(RCCARC) "RTN","RCDPESP5",115,0) . Q:RCRSN=-1 ; User requested to quit "RTN","RCDPESP5",116,0) . ; "RTN","RCDPESP5",117,0) . ; Confirm save "RTN","RCDPESP5",118,0) . S RCYN=$$CONFIRM(2,PAID) ; Added PAID - PRCA*4.5*326 "RTN","RCDPESP5",119,0) . I (RCYN="N")!(RCYN=-1) W !,"NOT SAVED",!! Q "RTN","RCDPESP5",120,0) . ; "RTN","RCDPESP5",121,0) . ; Re-enable if disabled and quit "RTN","RCDPESP5",122,0) . I RCCIEN D Q "RTN","RCDPESP5",123,0) . . D UPDDATA(RCCIEN,1,RCNAMT,RCRSN,PAID) ; Renable and update amount - PAID added PRCA*4.5*326 "RTN","RCDPESP5",124,0) . . ; "RTN","RCDPESP5",125,0) . . ;Update audit file with reason and amount changes. "RTN","RCDPESP5",126,0) . . ; Order - File ; Field ; IEN ; New Value ; Old Value ; Comment "RTN","RCDPESP5",127,0) . . S FIELD=$S(PAID:.02,1:.08) ; PRCA*4.5*326 "RTN","RCDPESP5",128,0) . . S RCAUDARY(1)="344.62^"_FIELD_"^"_RCCIEN_"^1^"_RCSTAT_"^"_RCRSN ; PRCA*4.5*326 "RTN","RCDPESP5",129,0) . . S FIELD=$S(PAID:.06,1:.12) ; PRCA*4.5*326 "RTN","RCDPESP5",130,0) . . S RCAUDARY(2)="344.62^"_FIELD_"^"_RCCIEN_"^"_RCNAMT_"^"_RCAMT_"^"_RCRSN ; PRCA*4.5*326 "RTN","RCDPESP5",131,0) . . D AUDIT^RCDPESP(.RCAUDARY) "RTN","RCDPESP5",132,0) . . ; "RTN","RCDPESP5",133,0) . . ;At least 1 item was change/updated/added so set flag for reprint "RTN","RCDPESP5",134,0) . . I 'RCEDIT S RCEDIT=1 "RTN","RCDPESP5",135,0) . ; "RTN","RCDPESP5",136,0) . ; Store new entry "RTN","RCDPESP5",137,0) . D ADDDATA(RCCARC,RCNAMT,RCRSN,PAID) ; PAID added PRCA*4.5*326 "RTN","RCDPESP5",138,0) . ; "RTN","RCDPESP5",139,0) . ;Update audit file with reason and amount changes. "RTN","RCDPESP5",140,0) . S RCCIEN=$$FIND1^DIC(344.62,"","",RCCARC,"","","RCERR") I RCCIEN="" S RCCIEN="ERROR" "RTN","RCDPESP5",141,0) . ; "RTN","RCDPESP5",142,0) . ; Order - File ; Field ; IEN ; New Value ; Old Value ; Comment "RTN","RCDPESP5",143,0) . S FIELD=$S(PAID:.02,1:.08) ; PRCA*4.5*326 "RTN","RCDPESP5",144,0) . S RCAUDARY(1)="344.62^"_FIELD_"^"_RCCIEN_"^1^0^"_RCRSN ; PRCA*4.5*326 "RTN","RCDPESP5",145,0) . S FIELD=$S(PAID:.06,1:.12) ; PRCA*4.5*326 "RTN","RCDPESP5",146,0) . S RCAUDARY(2)="344.62^"_FIELD_"^"_RCCIEN_"^"_RCNAMT_"^0^"_RCRSN ; PRCA*4.5*326 "RTN","RCDPESP5",147,0) . D AUDIT^RCDPESP(.RCAUDARY) "RTN","RCDPESP5",148,0) . ; "RTN","RCDPESP5",149,0) . ;At least 1 item was change/updated/added so set flag for reprint "RTN","RCDPESP5",150,0) . I 'RCEDIT S RCEDIT=1 "RTN","RCDPESP5",151,0) ; "RTN","RCDPESP5",152,0) Q "RTN","RCDPESP5",153,0) ; "RTN","RCDPESP5",154,0) PRTCARC(PAID) ;Display current entries that have been defined for inclusion or exclusion into - PAID added - PRCA*4.5*326 "RTN","RCDPESP5",155,0) ; "RTN","RCDPESP5",156,0) N FIELD,RCI,RCCT,RCSTRING,RCDATA,RCINACT,RCCARCD,RCDESC,RCCIEN,RCSTAT,RCCODE "RTN","RCDPESP5",157,0) ; "RTN","RCDPESP5",158,0) S RCI=0,RCCT=0,RCSTRING="" "RTN","RCDPESP5",159,0) S RCSTRING=$TR($J("",73)," ","-") "RTN","RCDPESP5",160,0) ; "RTN","RCDPESP5",161,0) ; Print Header "RTN","RCDPESP5",162,0) ; "RTN","RCDPESP5",163,0) W !!,?3,"CARC ",?9,"Description",?65,"Max. Amt" "RTN","RCDPESP5",164,0) W !,?3,RCSTRING "RTN","RCDPESP5",165,0) ; "RTN","RCDPESP5",166,0) ; Loop and print entries "RTN","RCDPESP5",167,0) F S RCI=$O(^RCY(344.62,RCI)) Q:'RCI D "RTN","RCDPESP5",168,0) . S RCDATA=$G(^RCY(344.62,RCI,0)) "RTN","RCDPESP5",169,0) . Q:RCDATA="" "RTN","RCDPESP5",170,0) . S RCCODE=$P(RCDATA,U),RCCIEN=$O(^RC(345,"B",RCCODE,"")) "RTN","RCDPESP5",171,0) . S RCDESC=$G(^RC(345,RCCIEN,1,1,0)) "RTN","RCDPESP5",172,0) . S FIELD=$S(PAID:.02,1:.08) "RTN","RCDPESP5",173,0) . S RCSTAT=$$GET1^DIQ(344.62,RCI,FIELD,"I") "RTN","RCDPESP5",174,0) . Q:RCSTAT'=1 "RTN","RCDPESP5",175,0) . S RCCT=RCCT+1 "RTN","RCDPESP5",176,0) . I $L(RCDESC)>50 S RCDESC=$E(RCDESC,1,50)_" ..." "RTN","RCDPESP5",177,0) . D GETCODES^RCDPCRR(RCCODE,"","B",$$DT^XLFDT,"RCCARCD","1^70") "RTN","RCDPESP5",178,0) . S FIELD=$S(PAID:.06,1:.12) "RTN","RCDPESP5",179,0) . W !,?3,RCCODE,?9,$E(RCDESC,1,55),?63,$J($$GET1^DIQ(344.62,RCI,FIELD,"I"),10,0) "RTN","RCDPESP5",180,0) . I $P(RCCARCD("CARC",RCCODE,RCCIEN),U,3)'="" W " (I)" ; if inactive, display (I) "RTN","RCDPESP5",181,0) . K RCCARCD "RTN","RCDPESP5",182,0) ; "RTN","RCDPESP5",183,0) I RCCT=0 W !,?5,"NO CARC/AMOUNTS ENTERED" "RTN","RCDPESP5",184,0) Q "RTN","RCDPESP5",185,0) ; "RTN","RCDPESP5",186,0) ;Retrieve the next CARC code to enable/disable "RTN","RCDPESP5",187,0) GETCARC() ; "RTN","RCDPESP5",188,0) N DA,DIR,DTOUT,DUOUT,X,Y,DIRUT,DIROUT "RTN","RCDPESP5",189,0) S DIR("?")="Enter a CARC code to enable/disable or Q to Quit." "RTN","RCDPESP5",190,0) S DIR(0)="FAO" "RTN","RCDPESP5",191,0) S DIR("??")="^D LIST^RCDPCRR(345)" "RTN","RCDPESP5",192,0) S DIR("A")="CARC: " "RTN","RCDPESP5",193,0) D ^DIR "RTN","RCDPESP5",194,0) K DIR "RTN","RCDPESP5",195,0) I $D(DTOUT)!$D(DUOUT) Q -1 "RTN","RCDPESP5",196,0) I Y="" Q 0 "RTN","RCDPESP5",197,0) Q Y "RTN","RCDPESP5",198,0) ; "RTN","RCDPESP5",199,0) ;Ask user to change or disable an enabled CARC auto-decrement "RTN","RCDPESP5",200,0) CHGDIS() ; "RTN","RCDPESP5",201,0) N DA,DIR,DTOUT,DUOUT,X,Y,DIRUT,DIROUT "RTN","RCDPESP5",202,0) S DIR("?")="Either (D)isable the CARC from Auto-Decrease or (C)hange the maximum amount of Auto-Decrease." "RTN","RCDPESP5",203,0) S DIR(0)="FA" "RTN","RCDPESP5",204,0) S DIR("A")="(C)hange or (D)isable: " "RTN","RCDPESP5",205,0) S DIR("S")="C:Change;D:Disable" "RTN","RCDPESP5",206,0) D ^DIR "RTN","RCDPESP5",207,0) K DIR "RTN","RCDPESP5",208,0) Q Y "RTN","RCDPESP5",209,0) ; "RTN","RCDPESP5",210,0) ;Ask user to change or disable an enabled CARC auto-decrement "RTN","RCDPESP5",211,0) CONFIRM(RCIDX,PAID) ; Added PAID - PRCA*4.5*326 "RTN","RCDPESP5",212,0) N DA,DIR,DTOUT,DUOUT,DIRUT,DIROUT,RCTXT,X,Y "RTN","RCDPESP5",213,0) ; "RTN","RCDPESP5",214,0) S RCTXT=$S(PAID:"",1:"NO-PAY ") ; PRCA*4.5*326 "RTN","RCDPESP5",215,0) ; Confirm if the CARC code is correct "RTN","RCDPESP5",216,0) I RCIDX=1 D "RTN","RCDPESP5",217,0) . S DIR("?")="Either (Y)es to confirm that this is the correct code or (N)o to enter a different code." "RTN","RCDPESP5",218,0) . S DIR("A")="ENABLE this CARC for Auto-Decrease of "_RCTXT_"Medical Claims (Y/N)? " "RTN","RCDPESP5",219,0) ; "RTN","RCDPESP5",220,0) ; Confirm if the user wishes to Enable the changes "RTN","RCDPESP5",221,0) I RCIDX=2 D "RTN","RCDPESP5",222,0) . S DIR("?")="Either (Y)es to confirm changes or (N)o to exit without saving." "RTN","RCDPESP5",223,0) . S DIR("A")="Save this CARC? (Y)es or (N)o: " "RTN","RCDPESP5",224,0) ; "RTN","RCDPESP5",225,0) ; Confirm if the user wishes to Disable the changes "RTN","RCDPESP5",226,0) I RCIDX=3 D "RTN","RCDPESP5",227,0) . S DIR("?")="Either (Y)es to confirm changes or (N)o to exit without saving." "RTN","RCDPESP5",228,0) . S DIR("A")="Remove this CARC? (Y)es or (N)o: " "RTN","RCDPESP5",229,0) ; "RTN","RCDPESP5",230,0) ; Confirm if the CARC code is correct "RTN","RCDPESP5",231,0) I RCIDX=4 D "RTN","RCDPESP5",232,0) . S DIR("?")="Either (Y)es to confirm that this is the correct code or (N)o to enter a different code." "RTN","RCDPESP5",233,0) . S DIR("A")="DISABLE this CARC for Auto-Decrease of "_RCTXT_"Medical Claims (Y/N)? " "RTN","RCDPESP5",234,0) ; "RTN","RCDPESP5",235,0) S DIR(0)="YA" "RTN","RCDPESP5",236,0) S DIR("S")="Y:Yes;N:No" "RTN","RCDPESP5",237,0) D ^DIR "RTN","RCDPESP5",238,0) K DIR "RTN","RCDPESP5",239,0) I $G(DTOUT)!$G(DUOUT) S Y=-1 "RTN","RCDPESP5",240,0) I Y="0" S Y=-1 "RTN","RCDPESP5",241,0) Q Y "RTN","RCDPESP5",242,0) ; "RTN","RCDPESP5",243,0) ;Ask user the maximum amount to allow for auto-decrease "RTN","RCDPESP5",244,0) GETAMT() ; "RTN","RCDPESP5",245,0) ; BEGIN PRCA*4.5*326 "RTN","RCDPESP5",246,0) N DA,DIR,DIRUT,DIROUT,DTOUT,DUOUT,RCMAX,X,Y "RTN","RCDPESP5",247,0) S RCMAX=+$$GET1^DIQ(344.61,"1,",.05) "RTN","RCDPESP5",248,0) S DIR("?")="Enter the maximum amount the CARC can be auto-decreased between $1 and $"_RCMAX "RTN","RCDPESP5",249,0) S DIR(0)="NA^1:"_RCMAX_":0" "RTN","RCDPESP5",250,0) S DIR("A")="MAXIMUM DOLLAR AMOUNT TO AUTO-DECREASE PER CLAIM (1-"_RCMAX_"): " "RTN","RCDPESP5",251,0) ; END PRCA*4.5*326 "RTN","RCDPESP5",252,0) D ^DIR "RTN","RCDPESP5",253,0) K DIR "RTN","RCDPESP5",254,0) I $G(DUOUT) S Y=-1 "RTN","RCDPESP5",255,0) Q Y "RTN","RCDPESP5",256,0) ; "RTN","RCDPESP5",257,0) ;Get the reason for modification "RTN","RCDPESP5",258,0) GETREASN(RCCARC) ; "RTN","RCDPESP5",259,0) N DA,DIR,DTOUT,DUOUT,X,Y,DIRUT,DIROUT "RTN","RCDPESP5",260,0) S DIR("?")="Enter reason for enabling/disabling, or changing the Maximum Dollar decrease amount for CARC "_RCCARC_" (3-50 chars)." "RTN","RCDPESP5",261,0) S DIR(0)="FA^3:50" "RTN","RCDPESP5",262,0) S DIR("A")="COMMENT: " "RTN","RCDPESP5",263,0) S DIR("PRE")="S X=$$TRIM^XLFSTR(X,""LR"")" ; comment required and should be significant "RTN","RCDPESP5",264,0) D ^DIR "RTN","RCDPESP5",265,0) K DIR "RTN","RCDPESP5",266,0) I $G(DUOUT) S Y=-1 "RTN","RCDPESP5",267,0) Q Y "RTN","RCDPESP5",268,0) ; "RTN","RCDPESP5",269,0) ;Update the database and audit log "RTN","RCDPESP5",270,0) UPDDATA(RCCIEN,RCSTAT,RCAMT,RCRSN,PAID) ; PAID added PRCA*4.5*326 "RTN","RCDPESP5",271,0) N DA,DR,DIE,DTOUT,X,Y,DIC "RTN","RCDPESP5",272,0) ; replaced //// with /// in following 5 lines - PRCA*4.5*321 "RTN","RCDPESP5",273,0) S DA=RCCIEN,(DIC,DIE)="^RCY(344.62," "RTN","RCDPESP5",274,0) ; BEGIN - PRCA*4.5*326 "RTN","RCDPESP5",275,0) ; Paid lines "RTN","RCDPESP5",276,0) I PAID=1 D "RTN","RCDPESP5",277,0) .S DR=".02///"_RCSTAT_";" "RTN","RCDPESP5",278,0) .S DR=DR_".05///"_$$DT^XLFDT_";" ; PRCA*4.5*326 "RTN","RCDPESP5",279,0) .S DR=DR_".04///"_DUZ_";" "RTN","RCDPESP5",280,0) .S DR=DR_".06///"_RCAMT_";" "RTN","RCDPESP5",281,0) .S DR=DR_".07///"_RCRSN_";" "RTN","RCDPESP5",282,0) ; No-pay lines "RTN","RCDPESP5",283,0) I PAID=0 D "RTN","RCDPESP5",284,0) .S DR=".08///"_RCSTAT_";" "RTN","RCDPESP5",285,0) .S DR=DR_".11///"_$$DT^XLFDT_";" "RTN","RCDPESP5",286,0) .S DR=DR_".10///"_DUZ_";" "RTN","RCDPESP5",287,0) .S DR=DR_".12///"_RCAMT_";" "RTN","RCDPESP5",288,0) .S DR=DR_".13///"_RCRSN_";" "RTN","RCDPESP5",289,0) ; END - PRCA*4.5*326 "RTN","RCDPESP5",290,0) ; "RTN","RCDPESP5",291,0) L +^RCY(344.62,RCCIEN):10 E Q ; PRCA*4.5*326 timeout condition added "RTN","RCDPESP5",292,0) D ^DIE "RTN","RCDPESP5",293,0) L -^RCY(344.62,RCCIEN) "RTN","RCDPESP5",294,0) Q ; PRCA*4.5*326 - return value removed "RTN","RCDPESP5",295,0) ; "RTN","RCDPESP5",296,0) ;Add new entry to the table "RTN","RCDPESP5",297,0) ADDDATA(RCCARC,RCAMT,RCRSN,PAID) ; PAID added PRCA*4.5*326 "RTN","RCDPESP5",298,0) N RCENTRY,RCROOT,MSGROOT "RTN","RCDPESP5",299,0) ; "RTN","RCDPESP5",300,0) ; BEGIN - PRCA*4.5*326 "RTN","RCDPESP5",301,0) ; set up array for paid lines "RTN","RCDPESP5",302,0) I PAID=1 D "RTN","RCDPESP5",303,0) .S RCENTRY(344.62,"+1,",.01)=RCCARC ;CARC Code "RTN","RCDPESP5",304,0) .S RCENTRY(344.62,"+1,",.02)=1 ;Enabled status "RTN","RCDPESP5",305,0) .S RCENTRY(344.62,"+1,",.03)=$$DT^XLFDT ;Date added PRCA*4.5*326 "RTN","RCDPESP5",306,0) .S RCENTRY(344.62,"+1,",.04)=DUZ ;User "RTN","RCDPESP5",307,0) .S RCENTRY(344.62,"+1,",.06)=RCAMT ;Max amount "RTN","RCDPESP5",308,0) .S RCENTRY(344.62,"+1,",.07)=RCRSN ;Comment "RTN","RCDPESP5",309,0) ; set up array for no=pay lines "RTN","RCDPESP5",310,0) I PAID=0 D "RTN","RCDPESP5",311,0) .S RCENTRY(344.62,"+1,",.01)=RCCARC ;CARC Code "RTN","RCDPESP5",312,0) .S RCENTRY(344.62,"+1,",.08)=1 ;Enabled status "RTN","RCDPESP5",313,0) .S RCENTRY(344.62,"+1,",.09)=$$DT^XLFDT ;Date/Time added "RTN","RCDPESP5",314,0) .S RCENTRY(344.62,"+1,",.10)=DUZ ;User "RTN","RCDPESP5",315,0) .S RCENTRY(344.62,"+1,",.12)=RCAMT ;Max amount "RTN","RCDPESP5",316,0) .S RCENTRY(344.62,"+1,",.13)=RCRSN ;Comment "RTN","RCDPESP5",317,0) ; END - PRCA*4.5*326 "RTN","RCDPESP5",318,0) ;file entry "RTN","RCDPESP5",319,0) D UPDATE^DIE(,"RCENTRY","RCROOT","MSGROOT") "RTN","RCDPESP5",320,0) Q "RTN","RCDPESP5",321,0) ; "RTN","RCDPESP5",322,0) AUDIT() ; "RTN","RCDPESP5",323,0) ; "RTN","RCDPESP5",324,0) N EMEDANS,EOLDMED,EOLDRX,ERXANS,MEDANS,OLDMED,OLDRX,RXANS,TRICAA ; PRCA*4.5*321 "RTN","RCDPESP5",325,0) ; "RTN","RCDPESP5",326,0) ; Get existing answers for Medical and Pharmacy paper bills "RTN","RCDPESP5",327,0) S OLDMED=$$GET1^DIQ(342,"1,",7.05,"I") "RTN","RCDPESP5",328,0) S OLDRX=$$GET1^DIQ(342,"1,",7.06,"I") "RTN","RCDPESP5",329,0) ; "RTN","RCDPESP5",330,0) ; Get existing (#7.09) AUTO-AUDIT TRICARE EDI BILLS [9S] "RTN","RCDPESP5",331,0) S TRICAA("old")=$$GET1^DIQ(342,"1,",7.09,"I") "RTN","RCDPESP5",332,0) ; "RTN","RCDPESP5",333,0) ; Get existing answers for Medical and Pharmacy EDI (electronic) bills ; PRCA*4.5*321 "RTN","RCDPESP5",334,0) S EOLDMED=$$GET1^DIQ(342,"1,",7.07,"I") ; PRCA*4.5*321 "RTN","RCDPESP5",335,0) S EOLDRX=$$GET1^DIQ(342,"1,",7.08,"I") ; PRCA*4.5*321 "RTN","RCDPESP5",336,0) ; "RTN","RCDPESP5",337,0) ; Get Medical paper bills "RTN","RCDPESP5",338,0) S MEDANS=$$GETAUDIT(1) "RTN","RCDPESP5",339,0) Q:MEDANS=-1 1 "RTN","RCDPESP5",340,0) ; File Medical paper bills "RTN","RCDPESP5",341,0) I MEDANS'=OLDMED D "RTN","RCDPESP5",342,0) . N RCAUDVAL "RTN","RCDPESP5",343,0) . D FILEANS(7.05,MEDANS) "RTN","RCDPESP5",344,0) . ; FILE NUMBER^FIELD NUMBER^IEN^NEW VALUE^OLD VALUE^COMMENT "RTN","RCDPESP5",345,0) . S RCAUDVAL(1)="342^7.05^1^"_MEDANS_U_OLDMED_U_"Updating the Medical Auto-Audit of paper bills" "RTN","RCDPESP5",346,0) . D AUDIT^RCDPESP(.RCAUDVAL) "RTN","RCDPESP5",347,0) ; "RTN","RCDPESP5",348,0) ; Get Pharmacy paper bills "RTN","RCDPESP5",349,0) S RXANS=$$GETAUDIT(2) "RTN","RCDPESP5",350,0) Q:RXANS=-1 1 "RTN","RCDPESP5",351,0) ; "RTN","RCDPESP5",352,0) ; File Pharmacy paper bills "RTN","RCDPESP5",353,0) I RXANS'=OLDRX D "RTN","RCDPESP5",354,0) . N RCAUDVAL "RTN","RCDPESP5",355,0) . D FILEANS(7.06,RXANS) "RTN","RCDPESP5",356,0) . S RCAUDVAL(1)="342^7.06^1^"_RXANS_U_OLDRX_U_"Updating the Pharmacy Auto-Audit of paper bills" "RTN","RCDPESP5",357,0) . D AUDIT^RCDPESP(.RCAUDVAL) "RTN","RCDPESP5",358,0) ; "RTN","RCDPESP5",359,0) ; BEGIN PRCA*4.5*321 "RTN","RCDPESP5",360,0) ; Get Medical electronic bills "RTN","RCDPESP5",361,0) S EMEDANS=$$GETAUDIT(3) "RTN","RCDPESP5",362,0) Q:EMEDANS=-1 1 "RTN","RCDPESP5",363,0) ; File Medical electronic bills "RTN","RCDPESP5",364,0) I EMEDANS'=EOLDMED D "RTN","RCDPESP5",365,0) . N RCAUDVAL "RTN","RCDPESP5",366,0) . D FILEANS(7.07,EMEDANS) "RTN","RCDPESP5",367,0) . ; FILE NUMBER^FIELD NUMBER^IEN^NEW VALUE^OLD VALUE^COMMENT "RTN","RCDPESP5",368,0) . S RCAUDVAL(1)="342^7.07^1^"_EMEDANS_U_EOLDMED_U_"Updating the Medical Auto-Audit of electronic bills" "RTN","RCDPESP5",369,0) . D AUDIT^RCDPESP(.RCAUDVAL) "RTN","RCDPESP5",370,0) ; "RTN","RCDPESP5",371,0) ; Get Pharmacy electronic bills "RTN","RCDPESP5",372,0) S ERXANS=$$GETAUDIT(4) "RTN","RCDPESP5",373,0) Q:ERXANS=-1 1 "RTN","RCDPESP5",374,0) ; "RTN","RCDPESP5",375,0) ; File Pharmacy electronic bills "RTN","RCDPESP5",376,0) I ERXANS'=EOLDRX D "RTN","RCDPESP5",377,0) . N RCAUDVAL "RTN","RCDPESP5",378,0) . D FILEANS(7.08,ERXANS) "RTN","RCDPESP5",379,0) . S RCAUDVAL(1)="342^7.08^1^"_ERXANS_U_EOLDRX_U_"Updating the Pharmacy Auto-Audit of electronic bills" "RTN","RCDPESP5",380,0) . D AUDIT^RCDPESP(.RCAUDVAL) "RTN","RCDPESP5",381,0) ; END PRCA*4.5*321 "RTN","RCDPESP5",382,0) ; "RTN","RCDPESP5",383,0) S TRICAA("new")=$$GETAUDIT(5) "RTN","RCDPESP5",384,0) Q:TRICAA("new")=-1 1 "RTN","RCDPESP5",385,0) ; File (#7.09) AUTO-AUDIT TRICARE EDI BILLS [9S] - PRCA*4.5*332 "RTN","RCDPESP5",386,0) I TRICAA("new")'=TRICAA("old") D "RTN","RCDPESP5",387,0) . N RCAUDVAL "RTN","RCDPESP5",388,0) . D FILEANS(7.09,TRICAA("new")) "RTN","RCDPESP5",389,0) . ; FILE NUMBER^FIELD NUMBER^IEN^NEW VALUE^OLD VALUE^COMMENT "RTN","RCDPESP5",390,0) . S RCAUDVAL(1)="342^7.09^1^"_TRICAA("new")_U_TRICAA("old")_U_"Updating the Auto-Audit of Tricare bills" "RTN","RCDPESP5",391,0) . D AUDIT^RCDPESP(.RCAUDVAL) "RTN","RCDPESP5",392,0) ; "RTN","RCDPESP5",393,0) Q 0 "RTN","RCDPESP5",394,0) ; "RTN","RCDPESP5",395,0) ;Retrieve the parameter for the bill type "RTN","RCDPESP5",396,0) GETAUDIT(FLAG) ; "RTN","RCDPESP5",397,0) ; BEGIN PRCA*4.5*321 "RTN","RCDPESP5",398,0) ;FLAG - What audit type (1=Med Paper, 2=RX Paper, 3=Med EDI, 4=Rx EDI, 5=Tricare) "RTN","RCDPESP5",399,0) Q:'$G(FLAG) -1 "RTN","RCDPESP5",400,0) N DIR,DIROUT,DIRUT,DTOUT,DUOUT,FLDNO,RCANS,TYPL,TYPU,X,Y "RTN","RCDPESP5",401,0) S TYPL=$S(FLAG>2:"electronic",1:"paper") "RTN","RCDPESP5",402,0) S TYPU=$S(FLAG>2:"ELECTRONIC",1:"PAPER") "RTN","RCDPESP5",403,0) S FLDNO=$S(FLAG=1:7.05,FLAG=2:7.06,FLAG=3:7.07,FLAG=4:7.08,FLAG=5:7.09,1:0) "RTN","RCDPESP5",404,0) Q:'FLDNO -1 "RTN","RCDPESP5",405,0) ; "RTN","RCDPESP5",406,0) ; Prompt for Medical Auto-audit "RTN","RCDPESP5",407,0) D:$G(FLAG)#2=1 "RTN","RCDPESP5",408,0) . S DIR("A")="ENABLE AUTO-AUDIT FOR MEDICAL "_TYPU_" BILLS (Y/N): " "RTN","RCDPESP5",409,0) . S DIR("?",1)="Allow a site to automatically audit their Medical "_TYPL_" Bills" "RTN","RCDPESP5",410,0) . S DIR("?",2)="during the AR Nightly Process." "RTN","RCDPESP5",411,0) . S DIR("?",3)=" " "RTN","RCDPESP5",412,0) . S RCANS=$$GET1^DIQ(342,"1,",FLDNO) "RTN","RCDPESP5",413,0) ; "RTN","RCDPESP5",414,0) ; Prompt for Pharmacy Auto-audit "RTN","RCDPESP5",415,0) D:$G(FLAG)#2=0 "RTN","RCDPESP5",416,0) . S DIR("A")="ENABLE AUTO-AUDIT FOR PHARMACY "_TYPU_" BILLS (Y/N): " "RTN","RCDPESP5",417,0) . S DIR("?",1)="Allow a site to automatically audit their Pharmacy "_TYPL_" Bills" "RTN","RCDPESP5",418,0) . S DIR("?",2)="during the AR Nightly Process." "RTN","RCDPESP5",419,0) . S DIR("?",3)=" " "RTN","RCDPESP5",420,0) . S RCANS=$$GET1^DIQ(342,"1,",FLDNO) "RTN","RCDPESP5",421,0) ; END PRCA*4.5*321 "RTN","RCDPESP5",422,0) ; "RTN","RCDPESP5",423,0) ; Prompt for Tricare Auto-audit PRCA*4.5*332 "RTN","RCDPESP5",424,0) D:$G(FLAG)=5 "RTN","RCDPESP5",425,0) . S DIR("A")="ENABLE AUTO-AUDIT FOR TRICARE BILLS (Y/N): " "RTN","RCDPESP5",426,0) . S DIR("?",1)="Allow a site to automatically audit their Tricare Bills" "RTN","RCDPESP5",427,0) . S DIR("?",2)="during the AR Nightly Process." "RTN","RCDPESP5",428,0) . S DIR("?",3)=" " "RTN","RCDPESP5",429,0) . S RCANS=$$GET1^DIQ(342,"1,",7.09) "RTN","RCDPESP5",430,0) ; "RTN","RCDPESP5",431,0) S DIR(0)="YAO" "RTN","RCDPESP5",432,0) S DIR("?")="Enter Yes or No to select automatic processing of "_TYPL_" bills." ; PRCA*4.5*321 "RTN","RCDPESP5",433,0) S DIR("B")=$S($G(RCANS)'="":RCANS,1:"No") "RTN","RCDPESP5",434,0) D ^DIR K DIR "RTN","RCDPESP5",435,0) I Y="" Q "" "RTN","RCDPESP5",436,0) I $D(DTOUT)!$D(DUOUT)!(Y="") Q -1 "RTN","RCDPESP5",437,0) Q Y "RTN","RCDPESP5",438,0) ; "RTN","RCDPESP5",439,0) ;File the answer "RTN","RCDPESP5",440,0) FILEANS(FIELD,ANS) ; "RTN","RCDPESP5",441,0) ; "RTN","RCDPESP5",442,0) N DR,DIE,DA,DTOUT,DIDEL,X,Y "RTN","RCDPESP5",443,0) ; "RTN","RCDPESP5",444,0) ;Update Transaction "RTN","RCDPESP5",445,0) S DR=FIELD_"///"_ANS ;Original Confirmation # "RTN","RCDPESP5",446,0) S DIE="^RC(342," "RTN","RCDPESP5",447,0) S DA=1 "RTN","RCDPESP5",448,0) D ^DIE "RTN","RCDPESP5",449,0) ; "RTN","RCDPESP5",450,0) Q "RTN","RCDPESP5",451,0) ; "RTN","RCDPESP5",452,0) ;BEGIN PRCA*4.5*326 "RTN","RCDPESP5",453,0) CARCDSP(RCMAX) ; EP ^RCDPESP7 "RTN","RCDPESP5",454,0) N RCCHECK "RTN","RCDPESP5",455,0) ; "RTN","RCDPESP5",456,0) ; Check for CARCs that will be reset to the new maximum and display "RTN","RCDPESP5",457,0) S RCCHECK=0 "RTN","RCDPESP5",458,0) ; Paid line CARCs "RTN","RCDPESP5",459,0) D CHECK(RCMAX,1,1,.RCCHECK) "RTN","RCDPESP5",460,0) ; No-pay line CARCs "RTN","RCDPESP5",461,0) D CHECK(RCMAX,0,1,.RCCHECK) "RTN","RCDPESP5",462,0) ; "RTN","RCDPESP5",463,0) ; Finish if none found "RTN","RCDPESP5",464,0) Q:'RCCHECK 1 "RTN","RCDPESP5",465,0) ; "RTN","RCDPESP5",466,0) ; Ask if OK to proceed and reduce these CARCs "RTN","RCDPESP5",467,0) N DIR,DTOUT,DUOUT "RTN","RCDPESP5",468,0) S DIR(0)="YA" "RTN","RCDPESP5",469,0) S DIR("A")="Do you want to continue (Y/N)? " "RTN","RCDPESP5",470,0) W ! D ^DIR "RTN","RCDPESP5",471,0) ; Abort "RTN","RCDPESP5",472,0) I $D(DUOUT)!$D(DTOUT) Q "QUIT" "RTN","RCDPESP5",473,0) ; Go back and re-enter maximum amount "RTN","RCDPESP5",474,0) I 'Y Q 0 "RTN","RCDPESP5",475,0) ; "RTN","RCDPESP5",476,0) ; Update the CARCs previously displayed "RTN","RCDPESP5",477,0) S RCCHECK=0 "RTN","RCDPESP5",478,0) ; Update paid line CARCs "RTN","RCDPESP5",479,0) D CHECK(RCMAX,1,0,.RCCHECK) "RTN","RCDPESP5",480,0) ; Update no-pay line CARCs "RTN","RCDPESP5",481,0) D CHECK(RCMAX,0,0,.RCCHECK) "RTN","RCDPESP5",482,0) Q 1 "RTN","RCDPESP5",483,0) ; "RTN","RCDPESP5",484,0) CHECK(RCMAX,RCPAID,RCDSP,RCCNT) ;Display/Reset any CARC maximum values which exceed upper limit "RTN","RCDPESP5",485,0) ; Input - RCMAX = Maximum allowed $ decrease per claim (from #344.61, #.05) "RTN","RCDPESP5",486,0) ; RCPAID - 1 = CARCs for paid claims, 0 = CARC's for NO-PAY claims "RTN","RCDPESP5",487,0) ; RCDSP - 1 = display only, 0 = update only "RTN","RCDPESP5",488,0) ; RCCNT = cummulative count of pay and no-pay records found "RTN","RCDPESP5",489,0) ; Output - Updates #344.62 - RCDPE CARC-RARC AUTO DEC "RTN","RCDPESP5",490,0) ; Updates #344.7 - RCDPE PARAMETER AUDIT "RTN","RCDPESP5",491,0) ; "RTN","RCDPESP5",492,0) N RCACT,RCAMT,RCARR,RCCODE,RCCT,RCDESC,RCFLD,RCFLDA,RCI,RCINACT,RCSTAT,RCSUB,RCTXT "RTN","RCDPESP5",493,0) ; Max Amount field "RTN","RCDPESP5",494,0) S RCFLD=$S(RCPAID:.06,1:.12) "RTN","RCDPESP5",495,0) ; Auto-decrease Y/N field "RTN","RCDPESP5",496,0) S RCFLDA=$S(RCPAID:.02,1:.08) "RTN","RCDPESP5",497,0) ; Search for entries that need reducing "RTN","RCDPESP5",498,0) S RCI=0,RCARR=0 "RTN","RCDPESP5",499,0) F S RCI=$O(^RCY(344.62,RCI)) Q:'RCI D "RTN","RCDPESP5",500,0) . ; Check if this is an active code "RTN","RCDPESP5",501,0) . S RCACT=$$GET1^DIQ(344.62,RCI_",",RCFLDA,"I") "RTN","RCDPESP5",502,0) . Q:'RCACT "RTN","RCDPESP5",503,0) . ; Maximum amount for CARC "RTN","RCDPESP5",504,0) . S RCAMT=$$GET1^DIQ(344.62,RCI_",",RCFLD) "RTN","RCDPESP5",505,0) . ; Check if limit exceeded "RTN","RCDPESP5",506,0) . Q:RCAMT'>RCMAX "RTN","RCDPESP5",507,0) . ; Save CARC for reset and/or display "RTN","RCDPESP5",508,0) . S RCARR=RCARR+1,RCCNT=RCCNT+1 "RTN","RCDPESP5",509,0) . S RCARR(RCARR)=RCI_U_RCAMT "RTN","RCDPESP5",510,0) ; "RTN","RCDPESP5",511,0) Q:RCARR=0 "RTN","RCDPESP5",512,0) ; "RTN","RCDPESP5",513,0) I RCDSP=1 D "RTN","RCDPESP5",514,0) .S RCTXT=$S('RCPAID:"NO-PAY ",1:"") "RTN","RCDPESP5",515,0) .W !!,"Warning:" "RTN","RCDPESP5",516,0) .W !," The following "_RCTXT_"CARC codes' max. amt will be changed to the new limit $"_RCMAX "RTN","RCDPESP5",517,0) S RCSUB=0 "RTN","RCDPESP5",518,0) F S RCSUB=$O(RCARR(RCSUB)) Q:'RCSUB D "RTN","RCDPESP5",519,0) . S RCI=$P(RCARR(RCSUB),U) "RTN","RCDPESP5",520,0) . S RCAMT=$P(RCARR(RCSUB),U,2) "RTN","RCDPESP5",521,0) . ; Display line "RTN","RCDPESP5",522,0) . I RCDSP D "RTN","RCDPESP5",523,0) . . S RCCODE=$$GET1^DIQ(344.62,RCI_",",.01) "RTN","RCDPESP5",524,0) . . S RCCIEN=$O(^RC(345,"B",RCCODE,"")) "RTN","RCDPESP5",525,0) . . S RCDESC=$G(^RC(345,RCCIEN,1,1,0)) "RTN","RCDPESP5",526,0) . . I $L(RCDESC)>50 S RCDESC=$E(RCDESC,1,50)_" ..." "RTN","RCDPESP5",527,0) . . W !,?3,RCCODE,?9,$E(RCDESC,1,55),?63,$J(RCAMT,10,0) "RTN","RCDPESP5",528,0) . ; Reset CARC to top limit "RTN","RCDPESP5",529,0) . I 'RCDSP D "RTN","RCDPESP5",530,0) . . N RCAUDARY,RCSTAT,RCTXT "RTN","RCDPESP5",531,0) . . S RCSTAT=$$GET1^DIQ(344.62,RCI_",",.02) ; Leave status unchanged "RTN","RCDPESP5",532,0) . . S RCTXT="Max. Amt reduced to top limit" "RTN","RCDPESP5",533,0) . . ; Update #344.62 - RCDPE CARC-RARC AUTO DEC "RTN","RCDPESP5",534,0) . . D UPDDATA(RCI,RCSTAT,RCMAX,RCTXT,RCPAID) "RTN","RCDPESP5",535,0) . . S RCTXT="Updated automatically - over maximum allowed" "RTN","RCDPESP5",536,0) . . ; Update #344.7 - RCDPE PARAMETER AUDIT "RTN","RCDPESP5",537,0) . . S RCAUDARY(1)="344.62^"_RCFLD_"^"_RCI_"^"_RCMAX_"^"_RCAMT_"^"_RCTXT "RTN","RCDPESP5",538,0) . . D AUDIT^RCDPESP(.RCAUDARY) "RTN","RCDPESP5",539,0) Q "RTN","RCDPESP5",540,0) ; END PRCA*4.5*326 "RTN","RCDPESP6") 0^8^B65240726 "RTN","RCDPESP6",1,0) RCDPESP6 ;AITC/CJE - ePayment Lockbox Site Parameters - Notify Changes;27 Sept 2018 15:56:10 "RTN","RCDPESP6",2,0) ;;4.5;Accounts Receivable;**326,332**;;Build 40 "RTN","RCDPESP6",3,0) ;Per VA Directive 6402, this routine should not be modified. "RTN","RCDPESP6",4,0) ; "RTN","RCDPESP6",5,0) Q "RTN","RCDPESP6",6,0) EN ; On entry into parameter edit, save a snapshot of the files "RTN","RCDPESP6",7,0) ; Input: None "RTN","RCDPESP6",8,0) ; Output: ^TMP("RCDPESP6",$J) created by merging in files 344.6, 344.61 and 344.62 "RTN","RCDPESP6",9,0) K ^TMP("RCDPESP6",$J) "RTN","RCDPESP6",10,0) M ^TMP("RCDPESP6",$J,344.6)=^RCY(344.6) ; Save payer exclusions "RTN","RCDPESP6",11,0) M ^TMP("RCDPESP6",$J,344.61)=^RCY(344.61) ; Save parameters "RTN","RCDPESP6",12,0) M ^TMP("RCDPESP6",$J,344.62)=^RCY(344.62) ; Save CARC/RARC auto dec "RTN","RCDPESP6",13,0) Q "RTN","RCDPESP6",14,0) EXIT ; On exit from parameter edit, compare snapshot with live files. "RTN","RCDPESP6",15,0) ; Send a mail message if any designated items have changed. "RTN","RCDPESP6",16,0) ; Input: ^TMP("RCDPESP6",$J) created above by merging in files 344.6, 344.61 and 344.62 "RTN","RCDPESP6",17,0) ; Output: Mail message (if any parameters have changed) "RTN","RCDPESP6",18,0) ; "RTN","RCDPESP6",19,0) N CHANGES,CHGCNT,LINES,RCMSGTXT,RCSITE,RCSUBJ,XMINSTR,XMTO "RTN","RCDPESP6",20,0) ; "RTN","RCDPESP6",21,0) S CHGCNT=0 "RTN","RCDPESP6",22,0) S CHGCNT=$$CHKCHNG(.RCMSGTXT) ; Check for any changes in parameters "RTN","RCDPESP6",23,0) ; "RTN","RCDPESP6",24,0) I 'CHGCNT Q ; No changes made so don't send message "RTN","RCDPESP6",25,0) ; "RTN","RCDPESP6",26,0) S RCSITE=$$SITE^VASITE() "RTN","RCDPESP6",27,0) S RCSUBJ=$E("ePayments EDI Lockbox Parameters changed "_$P(RCSITE,U,2),1,65) "RTN","RCDPESP6",28,0) D HEADER(.RCMSGTXT,RCSITE) "RTN","RCDPESP6",29,0) ; "RTN","RCDPESP6",30,0) S XMINSTR("FROM")="POSTMASTER" "RTN","RCDPESP6",31,0) ; "RTN","RCDPESP6",32,0) S XMTO(DUZ)="",XMTO("G.RCDPE AUDIT")="" "RTN","RCDPESP6",33,0) ; "RTN","RCDPESP6",34,0) K ^TMP("XMERR",$J) "RTN","RCDPESP6",35,0) D SENDMSG^XMXAPI(DUZ,RCSUBJ,"RCMSGTXT",.XMTO,.XMINSTR) "RTN","RCDPESP6",36,0) ; "RTN","RCDPESP6",37,0) I $D(^TMP("XMERR",$J)) D "RTN","RCDPESP6",38,0) . N G "RTN","RCDPESP6",39,0) . D MES^XPDUTL("MailMan returned an error.") "RTN","RCDPESP6",40,0) . D MES^XPDUTL("The error text is:") "RTN","RCDPESP6",41,0) . S G=$NA(^TMP("XMERR",$J)) "RTN","RCDPESP6",42,0) . F S G=$Q(@G) Q:G="" Q:$QS(G,2)'=$J D MES^XPDUTL(" "_$C(34)_@G_$C(34)) "RTN","RCDPESP6",43,0) . D MES^XPDUTL(" * End of Error Text *") "RTN","RCDPESP6",44,0) . K ^TMP("XMERR",$J) "RTN","RCDPESP6",45,0) ; "RTN","RCDPESP6",46,0) K ^TMP("RCDPESP6",$J) ; Clean up saved files "RTN","RCDPESP6",47,0) Q "RTN","RCDPESP6",48,0) ; "RTN","RCDPESP6",49,0) HEADER(MSGTXT,RCSITE) ; Add Header Lines to the mail message text "RTN","RCDPESP6",50,0) ; Input: None "RTN","RCDPESP6",51,0) ; Output: Array MSGTXT passed by reference "RTN","RCDPESP6",52,0) ; "RTN","RCDPESP6",53,0) ; limit subject to 65 chars. "RTN","RCDPESP6",54,0) S MSGTXT(1)=" " "RTN","RCDPESP6",55,0) S MSGTXT(2)=" Site: "_$P(RCSITE,U,2) "RTN","RCDPESP6",56,0) S MSGTXT(3)=" Station # "_$P(RCSITE,U,3) "RTN","RCDPESP6",57,0) S MSGTXT(4)=" Domain: "_$G(^XMB("NETNAME")) "RTN","RCDPESP6",58,0) S MSGTXT(5)=" Date/Time: "_$$FMTE^XLFDT($$NOW^XLFDT,"1ZPM") "RTN","RCDPESP6",59,0) S MSGTXT(6)=" User: "_$P($G(^VA(200,DUZ,0)),U) "RTN","RCDPESP6",60,0) S MSGTXT(7)=" " "RTN","RCDPESP6",61,0) S MSGTXT(8)=" The following EDI Lockbox Site Parameters were changed: " "RTN","RCDPESP6",62,0) S MSGTXT(9)=" " "RTN","RCDPESP6",63,0) S MSGTXT(10)=$J("",50)_$J("OLD VALUE",10)_" "_$J("NEW VALUE",10) "RTN","RCDPESP6",64,0) Q "RTN","RCDPESP6",65,0) CHKCHNG(LINE) ; Check for changes in EDI Lockbox site parameters "RTN","RCDPESP6",66,0) ; Input: ^TMP("RCDPESP6",$J) - Copy of file 344.6, 344.61 and 344.62 taken on entry "RTN","RCDPESP6",67,0) ; Output: LINE - Change lines to add to the mail message. Passed by reference. "RTN","RCDPESP6",68,0) ; Return: COUNT of the number of changes. 0 if no changes were made. "RTN","RCDPESP6",69,0) N COUNT,DOTS,HEAD,IEN,J,RCDET,REC0,REC1,XNEW,XOLD "RTN","RCDPESP6",70,0) ; "RTN","RCDPESP6",71,0) S (COUNT,HEAD)=0,HEAD("SIZE")=10 "RTN","RCDPESP6",72,0) S HEAD("TXT")="ALL PAYERS" "RTN","RCDPESP6",73,0) S HEAD("DETAIL")="" "RTN","RCDPESP6",74,0) S DOTS=$TR($J(" ",40)," ",".") "RTN","RCDPESP6",75,0) ; Check parameters in 344.61 that apply to all payers "RTN","RCDPESP6",76,0) S REC0=$G(^TMP("RCDPESP6",$J,344.61,1,0)) "RTN","RCDPESP6",77,0) ; "RTN","RCDPESP6",78,0) ; Auto-post med claims enabled "RTN","RCDPESP6",79,0) S XOLD=$P(REC0,U,2) "RTN","RCDPESP6",80,0) S XNEW=$$GET1^DIQ(344.61,"1,",.02,"I") "RTN","RCDPESP6",81,0) I XNEW'=XOLD D ; "RTN","RCDPESP6",82,0) . D LNOUT(.HEAD,.LINE,"AUTO-POST MED CLAIMS ENABLED",XOLD,XNEW,"B",.COUNT) "RTN","RCDPESP6",83,0) ; "RTN","RCDPESP6",84,0) ; Auto-decrease med enabled "RTN","RCDPESP6",85,0) S XOLD=$P(REC0,U,3) "RTN","RCDPESP6",86,0) S XNEW=$$GET1^DIQ(344.61,"1,",.03,"I") "RTN","RCDPESP6",87,0) I XNEW'=XOLD D ; "RTN","RCDPESP6",88,0) . D LNOUT(.HEAD,.LINE,"AUTO-DECREASE MED ENABLED",XOLD,XNEW,"B",.COUNT) "RTN","RCDPESP6",89,0) ; "RTN","RCDPESP6",90,0) ; Auto-decrease med days "RTN","RCDPESP6",91,0) S XOLD=$P(REC0,U,4) "RTN","RCDPESP6",92,0) S XNEW=$$GET1^DIQ(344.61,"1,",.04,"I") "RTN","RCDPESP6",93,0) I XNEW'=XOLD D ; "RTN","RCDPESP6",94,0) . D LNOUT(.HEAD,.LINE,"AUTO-DECREASE DAYS DEFAULT",XOLD,XNEW,"D",.COUNT) "RTN","RCDPESP6",95,0) ; "RTN","RCDPESP6",96,0) ; Auto-decrease no-pay med enabled "RTN","RCDPESP6",97,0) S XOLD=$P(REC0,U,11) "RTN","RCDPESP6",98,0) S XNEW=$$GET1^DIQ(344.61,"1,",.11,"I") "RTN","RCDPESP6",99,0) I XNEW'=XOLD D ; "RTN","RCDPESP6",100,0) . D LNOUT(.HEAD,.LINE,"AUTO-DECREASE NO-PAY MED ENABLED",XOLD,XNEW,"B",.COUNT) "RTN","RCDPESP6",101,0) ; "RTN","RCDPESP6",102,0) ; Auto-decrease no-pay med days "RTN","RCDPESP6",103,0) S XOLD=$P(REC0,U,12) "RTN","RCDPESP6",104,0) S XNEW=$$GET1^DIQ(344.61,"1,",.12,"I") "RTN","RCDPESP6",105,0) I XNEW'=XOLD D ; "RTN","RCDPESP6",106,0) . D LNOUT(.HEAD,.LINE,"AUTO-DECREASE NO-PAY DAYS DEFAULT",XOLD,XNEW,"D",.COUNT) "RTN","RCDPESP6",107,0) ; "RTN","RCDPESP6",108,0) ; Auto-decrease med amount "RTN","RCDPESP6",109,0) S XOLD=$P(REC0,U,5) "RTN","RCDPESP6",110,0) S XNEW=$$GET1^DIQ(344.61,"1,",.05,"I") "RTN","RCDPESP6",111,0) I XNEW'=XOLD D ; "RTN","RCDPESP6",112,0) . D LNOUT(.HEAD,.LINE,"AUTO-DECREASE AMT DEFAULT",XOLD,XNEW,"$",.COUNT) "RTN","RCDPESP6",113,0) ; "RTN","RCDPESP6",114,0) ; TRICARE EFT POST PREVENT DAYS - PRCA*4.5*332 "RTN","RCDPESP6",115,0) S XOLD=$P(REC0,U,13) "RTN","RCDPESP6",116,0) S XNEW=$$GET1^DIQ(344.61,"1,",.13,"I") "RTN","RCDPESP6",117,0) I XNEW'=XOLD D ; "RTN","RCDPESP6",118,0) . D LNOUT(.HEAD,.LINE,"TRICARE EFT POST PREVENT DAYS",XOLD,XNEW,"D",.COUNT) "RTN","RCDPESP6",119,0) ; "RTN","RCDPESP6",120,0) S REC1=$G(^TMP("RCDPESP6",$J,344.61,1,1)) "RTN","RCDPESP6",121,0) ; Auto-post Rx "RTN","RCDPESP6",122,0) S XOLD=$P(REC1,U,1) "RTN","RCDPESP6",123,0) S XNEW=$$GET1^DIQ(344.61,"1,",1.01,"I") "RTN","RCDPESP6",124,0) I XNEW'=XOLD D ; "RTN","RCDPESP6",125,0) . D LNOUT(.HEAD,.LINE,"AUTO-POST RX CLAIMS ENABLED",XOLD,XNEW,"B",.COUNT) "RTN","RCDPESP6",126,0) ; "RTN","RCDPESP6",127,0) ; Auto-decrease Rx "RTN","RCDPESP6",128,0) S XOLD=$P(REC1,U,2) "RTN","RCDPESP6",129,0) S XNEW=$$GET1^DIQ(344.61,"1,",1.02,"I") "RTN","RCDPESP6",130,0) I XNEW'=XOLD D ; "RTN","RCDPESP6",131,0) . D LNOUT(.HEAD,.LINE,"AUTO-DECREASE RX ENABLED",XOLD,XNEW,"B",.COUNT) "RTN","RCDPESP6",132,0) ; "RTN","RCDPESP6",133,0) ; Check each payer in 344.6 for changes "RTN","RCDPESP6",134,0) S IEN=0 "RTN","RCDPESP6",135,0) F S IEN=$O(^RCY(344.6,IEN)) Q:'IEN D ; "RTN","RCDPESP6",136,0) . S REC0=$G(^TMP("RCDPESP6",$J,344.6,IEN,0)) "RTN","RCDPESP6",137,0) . S HEAD=0 "RTN","RCDPESP6",138,0) . S HEAD("DETAIL")=$$GET1^DIQ(344.6,IEN_",",.01,"E") ; PRCA*4.5*332 "RTN","RCDPESP6",139,0) . S HEAD("TXT")="PAYER: "_HEAD("DETAIL") ; PRCA*4.5*332 "RTN","RCDPESP6",140,0) . ; Exclude med claims posting "RTN","RCDPESP6",141,0) . S XOLD=$P(REC0,U,6) "RTN","RCDPESP6",142,0) . S XNEW=$$GET1^DIQ(344.6,IEN_",",.06,"I") "RTN","RCDPESP6",143,0) . I XOLD'=XNEW D ; "RTN","RCDPESP6",144,0) . . D LNOUT(.HEAD,.LINE,"EXCLUDE MED CLAIMS POSTING",XOLD,XNEW,"B",.COUNT) "RTN","RCDPESP6",145,0) . ; Exclude med claims decrease "RTN","RCDPESP6",146,0) . S XOLD=$P(REC0,U,7) "RTN","RCDPESP6",147,0) . S XNEW=$$GET1^DIQ(344.6,IEN_",",.07,"I") "RTN","RCDPESP6",148,0) . I XOLD'=XNEW D ; "RTN","RCDPESP6",149,0) . . D LNOUT(.HEAD,.LINE,"EXCLUDE MED CLAIMS DECREASE",XOLD,XNEW,"B",.COUNT) "RTN","RCDPESP6",150,0) . ; Exclude Rx claim posting "RTN","RCDPESP6",151,0) . S XOLD=$P(REC0,U,8) "RTN","RCDPESP6",152,0) . S XNEW=$$GET1^DIQ(344.6,IEN_",",.08,"I") "RTN","RCDPESP6",153,0) . I XOLD'=XNEW D ; "RTN","RCDPESP6",154,0) . . D LNOUT(.HEAD,.LINE,"EXCLUDE RX CLAIM POSTING",XOLD,XNEW,"B",.COUNT) "RTN","RCDPESP6",155,0) ; "RTN","RCDPESP6",156,0) ; Check each CARC-RARC in 344.62 for changes "RTN","RCDPESP6",157,0) S IEN=0 "RTN","RCDPESP6",158,0) F S IEN=$O(^RCY(344.62,IEN)) Q:'IEN D ; "RTN","RCDPESP6",159,0) . S REC0=$G(^TMP("RCDPESP6",$J,344.62,IEN,0)) "RTN","RCDPESP6",160,0) . S REC1=$G(^TMP("RCDPESP6",$J,344.62,IEN,1)) "RTN","RCDPESP6",161,0) . S HEAD=0 "RTN","RCDPESP6",162,0) . S HEAD("DETAIL")=$$GET1^DIQ(344.62,IEN_",",.01,"E") ; PRCA*4.5*332 "RTN","RCDPESP6",163,0) . S HEAD("TXT")="CARC/RARK CODE: "_HEAD("DETAIL") "RTN","RCDPESP6",164,0) . S REC0=$G(^TMP("RCDPESP6",$J,344.62,IEN,0)) "RTN","RCDPESP6",165,0) . ; CARC auto decrease "RTN","RCDPESP6",166,0) . S XOLD=$P(REC0,U,2) "RTN","RCDPESP6",167,0) . S XNEW=$$GET1^DIQ(344.62,IEN_",",.02,"I") "RTN","RCDPESP6",168,0) . I XOLD'=XNEW D ; "RTN","RCDPESP6",169,0) . . D LNOUT(.HEAD,.LINE,"CARC AUTO DECREASE",XOLD,XNEW,"B",.COUNT) "RTN","RCDPESP6",170,0) . ; CARC decrease amount "RTN","RCDPESP6",171,0) . S XOLD=$P(REC0,U,6) "RTN","RCDPESP6",172,0) . S XNEW=$$GET1^DIQ(344.62,IEN_",",.06,"I") "RTN","RCDPESP6",173,0) . I XOLD'=XNEW D ; "RTN","RCDPESP6",174,0) . . D LNOUT(.HEAD,.LINE,"CARC DECREASE AMOUNT",XOLD,XNEW,"$",.COUNT) "RTN","RCDPESP6",175,0) . ; "RTN","RCDPESP6",176,0) . ; CARC auto decrease no-pay "RTN","RCDPESP6",177,0) . S XOLD=$P(REC1,U,1) "RTN","RCDPESP6",178,0) . S XNEW=$$GET1^DIQ(344.62,IEN_",",.08,"I") "RTN","RCDPESP6",179,0) . I XOLD'=XNEW D ; "RTN","RCDPESP6",180,0) . . D LNOUT(.HEAD,.LINE,"CARC AUTO DECREASE NO-PAY",XOLD,XNEW,"B",.COUNT) "RTN","RCDPESP6",181,0) . ; CARC decrease amount no pay "RTN","RCDPESP6",182,0) . S XOLD=$P(REC1,U,5) "RTN","RCDPESP6",183,0) . S XNEW=$$GET1^DIQ(344.62,IEN_",",.12,"I") "RTN","RCDPESP6",184,0) . I XOLD'=XNEW D ; "RTN","RCDPESP6",185,0) . . D LNOUT(.HEAD,.LINE,"CARC DECREASE AMOUNT NO-PAY",XOLD,XNEW,"$",.COUNT) "RTN","RCDPESP6",186,0) ; "RTN","RCDPESP6",187,0) Q COUNT "RTN","RCDPESP6",188,0) ; "RTN","RCDPESP6",189,0) LNOUT(HEAD,LINE,TXT,XOLD,XNEW,TYPE,COUNT) ; Format a line for the message "RTN","RCDPESP6",190,0) ; Input: TXT - Description of the changed field "RTN","RCDPESP6",191,0) ; XOLD - Old Value (Internal format) "RTN","RCDPESP6",192,0) ; XNEW - New Value (Internal Format) "RTN","RCDPESP6",193,0) ; Type - "B" - Boolean 1-Yes, 0 - N "RTN","RCDPESP6",194,0) ; "$" - Dollar amount "RTN","RCDPESP6",195,0) ; "D" - Days "RTN","RCDPESP6",196,0) ; "T" - Text "RTN","RCDPESP6",197,0) ; Output: COUNT passed by reference "RTN","RCDPESP6",198,0) ; HEAD passed by reference "RTN","RCDPESP6",199,0) ; LINE passed by reference "RTN","RCDPESP6",200,0) ; "RTN","RCDPESP6",201,0) N RCFDA,RCIENS,RETURN "RTN","RCDPESP6",202,0) ; Output header for this section if not already done "RTN","RCDPESP6",203,0) I 'HEAD D ; "RTN","RCDPESP6",204,0) . S COUNT=COUNT+1 "RTN","RCDPESP6",205,0) . S LINE(COUNT+HEAD("SIZE"))=HEAD("TXT") "RTN","RCDPESP6",206,0) . S HEAD=1 "RTN","RCDPESP6",207,0) ; "RTN","RCDPESP6",208,0) S COUNT=COUNT+1 "RTN","RCDPESP6",209,0) S LINE(COUNT+HEAD("SIZE"))=$E(" "_TXT_DOTS,1,50) "RTN","RCDPESP6",210,0) S LINE(COUNT+HEAD("SIZE"))=LINE(COUNT+HEAD("SIZE"))_$J($$FORMAT(XOLD,TYPE),10)_" "_$J($$FORMAT(XNEW,TYPE),10) "RTN","RCDPESP6",211,0) ; "RTN","RCDPESP6",212,0) ;PRCA*4.5*332 - Save changes into multiple 344.611 for history report "RTN","RCDPESP6",213,0) S RCIENS="+1,1," "RTN","RCDPESP6",214,0) S RCFDA(344.611,RCIENS,.01)=$$NOW^XLFDT() "RTN","RCDPESP6",215,0) S RCFDA(344.611,RCIENS,.02)=DUZ "RTN","RCDPESP6",216,0) S RCFDA(344.611,RCIENS,1)=TXT "RTN","RCDPESP6",217,0) S RCFDA(344.611,RCIENS,2)=HEAD("DETAIL") "RTN","RCDPESP6",218,0) S RCFDA(344.611,RCIENS,3)=$$FORMAT(XOLD,TYPE) "RTN","RCDPESP6",219,0) S RCFDA(344.611,RCIENS,4)=$$FORMAT(XNEW,TYPE) "RTN","RCDPESP6",220,0) D UPDATE^DIE("","RCFDA","RCIENS") "RTN","RCDPESP6",221,0) Q "RTN","RCDPESP6",222,0) ; "RTN","RCDPESP6",223,0) FORMAT(VALUE,TYPE) ; Format a value for output - Added for PRCA*4.5*332 "RTN","RCDPESP6",224,0) ; Input: VALUE - Value to be formated "RTN","RCDPESP6",225,0) ; TYPE - "$" - Dollar amount, B - Boolean "RTN","RCDPESP6",226,0) ; Return: Formated value "RTN","RCDPESP6",227,0) ; "RTN","RCDPESP6",228,0) S RETURN=VALUE "RTN","RCDPESP6",229,0) I TYPE="B" D ; "RTN","RCDPESP6",230,0) . S RETURN=$S(VALUE:"YES",1:"NO") "RTN","RCDPESP6",231,0) I TYPE="$" D ; "RTN","RCDPESP6",232,0) . S RETURN=$FN(VALUE,",",2) "RTN","RCDPESP6",233,0) Q RETURN "RTN","RCDPESP6",234,0) ; "RTN","RCDPESP6",235,0) PAYEN ; (EN) On entry into identify payers option, save a snapshot of file 344.6 - Added for PRCA*4.5*332 "RTN","RCDPESP6",236,0) ; Input: None "RTN","RCDPESP6",237,0) ; Output: ^TMP("RCDPESP6",$J) created by merging in files 344.6, 344.61 and 344.62 "RTN","RCDPESP6",238,0) K ^TMP("RCDPESP6",$J) "RTN","RCDPESP6",239,0) M ^TMP("RCDPESP6",$J,344.6)=^RCY(344.6) ; Save payer exclusions "RTN","RCDPESP6",240,0) Q "RTN","RCDPESP6",241,0) PAYEX ; (EN) On exit from identify payers option, compare snapshot with live files. - Added for PRCA*4.5*332 "RTN","RCDPESP6",242,0) ; Save changes to the parameter audit multiple 344.611 "RTN","RCDPESP6",243,0) ; Input: ^TMP("RCDPESP6",$J) created above by merging in file 344.6 "RTN","RCDPESP6",244,0) ; Output: Enties in multiple 344.611 to keep history of payer flag changes "RTN","RCDPESP6",245,0) ; "RTN","RCDPESP6",246,0) N COUNT,DOTS,IEN,REC0,HEAD,LINE,XOLD,XNEW "RTN","RCDPESP6",247,0) ; "RTN","RCDPESP6",248,0) S HEAD=0,HEAD("SIZE")=10 "RTN","RCDPESP6",249,0) S DOTS="" F J=1:1:40 S DOTS=DOTS_"." "RTN","RCDPESP6",250,0) ; "RTN","RCDPESP6",251,0) S COUNT=0 "RTN","RCDPESP6",252,0) ; Check each payer in 344.6 for changes "RTN","RCDPESP6",253,0) S IEN=0 "RTN","RCDPESP6",254,0) F S IEN=$O(^RCY(344.6,IEN)) Q:'IEN D ; "RTN","RCDPESP6",255,0) . S REC0=$G(^TMP("RCDPESP6",$J,344.6,IEN,0)) "RTN","RCDPESP6",256,0) . S HEAD("DETAIL")=$$GET1^DIQ(344.6,IEN_",",.01,"E") "RTN","RCDPESP6",257,0) . S HEAD("TXT")="PAYER: "_HEAD("DETAIL") "RTN","RCDPESP6",258,0) . ; Pharmacy Flag "RTN","RCDPESP6",259,0) . S XOLD=$P(REC0,U,9) "RTN","RCDPESP6",260,0) . S XNEW=$$GET1^DIQ(344.6,IEN_",",.09,"I") "RTN","RCDPESP6",261,0) . I (+XOLD)'=(+XNEW) D ; "RTN","RCDPESP6",262,0) . . D LNOUT(.HEAD,.LINE,"PHARMACY FLAG",XOLD,XNEW,"B",.COUNT) "RTN","RCDPESP6",263,0) . ; Tricare flag "RTN","RCDPESP6",264,0) . S XOLD=$P(REC0,U,10) "RTN","RCDPESP6",265,0) . S XNEW=$$GET1^DIQ(344.6,IEN_",",.1,"I") "RTN","RCDPESP6",266,0) . I (+XOLD)'=(+XNEW) D ; "RTN","RCDPESP6",267,0) . . D LNOUT(.HEAD,.LINE,"TRICARE FLAG",XOLD,XNEW,"B",.COUNT) "RTN","RCDPESP6",268,0) Q "RTN","RCDPESP6",269,0) ; "RTN","RCDPESP8") 0^10^B22209300 "RTN","RCDPESP8",1,0) RCDPESP8 ;AITC/CJE - ePayment Lockbox Site Parameters History "RTN","RCDPESP8",2,0) ;;4.5;Accounts Receivable;**332**;Mar 20, 1995;Build 40 "RTN","RCDPESP8",3,0) ;;Per VA Directive 6402, this routine should not be modified. "RTN","RCDPESP8",4,0) ; "RTN","RCDPESP8",5,0) EN ; entry point for EDI Lockbox Parameters History Report [RCDPE PARAMETER HISTORY REPORT] "RTN","RCDPESP8",6,0) N BDATE,EDATE,RCHDR,IEN2,POP,RCDATE,RCDISPTY,RCEND,RCLN,RCNEW,RCOLD,RCPGNUM,RCSTOP,RCTMPND,RCUSRVALMHDR "RTN","RCDPESP8",7,0) K ^TMP($J,"RCDPESP8") "RTN","RCDPESP8",8,0) Q:$$PROMPTS(.BDATE,.EDATE,.RCLM)=-1 ; Prompt for report parameters "RTN","RCDPESP8",9,0) ; "RTN","RCDPESP8",10,0) S RCPGNUM=0,RCSTOP=0 "RTN","RCDPESP8",11,0) I RCLM D G EXIT "RTN","RCDPESP8",12,0) . S RCTMPND="RCDPESP8" K ^TMP($J,RCTMPND) ; clean any residue "RTN","RCDPESP8",13,0) . D COMPILE "RTN","RCDPESP8",14,0) . D LMRPT^RCDPEARL(.VALMHDR,$NA(^TMP($J,RCTMPND))) ; generate ListMan display "RTN","RCDPESP8",15,0) . I $D(RCTMPND) K ^TMP($J,RCTMPND) "RTN","RCDPESP8",16,0) ; "RTN","RCDPESP8",17,0) W ! "RTN","RCDPESP8",18,0) S %ZIS="QM" D ^%ZIS Q:POP "RTN","RCDPESP8",19,0) I $D(IO("Q")) D Q "RTN","RCDPESP8",20,0) .N ZTDESC,ZTRTN,ZTSAVE,ZTSK "RTN","RCDPESP8",21,0) .S ZTRTN="COMPILE^RCDPESP8",ZTDESC="EDI LOCKBOX AUTO PARAMETER HISTORY REPORT" "RTN","RCDPESP8",22,0) .S ZTSAVE("*")="" "RTN","RCDPESP8",23,0) .D ^%ZTLOAD "RTN","RCDPESP8",24,0) .W !!,$S($D(ZTSK):"Your task number"_ZTSK_" has been queued.",1:"Unable to queue this job.") "RTN","RCDPESP8",25,0) .K IO("Q") D HOME^%ZIS "RTN","RCDPESP8",26,0) ; "RTN","RCDPESP8",27,0) U IO "RTN","RCDPESP8",28,0) D COMPILE "RTN","RCDPESP8",29,0) I 'RCSTOP D ASK^RCDPEARL(.RCSTOP) "RTN","RCDPESP8",30,0) ; "RTN","RCDPESP8",31,0) Q "RTN","RCDPESP8",32,0) COMPILE ; Get data for user selected date range "RTN","RCDPESP8",33,0) N IEN2,LINE,LMHDR,RCDET,RCPARAM,RCSEQ,RCUSR,SPACE,SPLIT "RTN","RCDPESP8",34,0) S SPACE=$J("",40) "RTN","RCDPESP8",35,0) S RCSEQ=0 "RTN","RCDPESP8",36,0) S RCDATE=BDATE,RCEND=EDATE_"."_24 "RTN","RCDPESP8",37,0) F S RCDATE=$O(^RCY(344.61,1,2,"ADU",RCDATE)) Q:(RCDATE>RCEND)!(RCDATE="") D ; "RTN","RCDPESP8",38,0) . S RCUSR="" "RTN","RCDPESP8",39,0) . F S RCUSR=$O(^RCY(344.61,1,2,"ADU",RCDATE,RCUSR)) Q:RCUSR="" D ; "RTN","RCDPESP8",40,0) . . S RCSEQ=RCSEQ+1 "RTN","RCDPESP8",41,0) . . S ^TMP($J,"RCDPESP8",RCSEQ)=$E($$FMTE^XLFDT(RCDATE,"2Z")_SPACE,1,19)_RCUSR "RTN","RCDPESP8",42,0) . . S IEN2="" "RTN","RCDPESP8",43,0) . . F S IEN2=$O(^RCY(344.61,1,2,"ADU",RCDATE,RCUSR,IEN2)) Q:IEN2="" D ; "RTN","RCDPESP8",44,0) . . . S RCPARAM=$$GET1^DIQ(344.611,IEN2_",1,",1,"E") "RTN","RCDPESP8",45,0) . . . S RCDET=$$GET1^DIQ(344.611,IEN2_",1,",2,"E") "RTN","RCDPESP8",46,0) . . . S RCOLD=$$GET1^DIQ(344.611,IEN2_",1,",3,"E") "RTN","RCDPESP8",47,0) . . . S RCNEW=$$GET1^DIQ(344.611,IEN2_",1,",4,"E") "RTN","RCDPESP8",48,0) . . . S SPLIT=0 "RTN","RCDPESP8",49,0) . . . S RCSEQ=RCSEQ+1 "RTN","RCDPESP8",50,0) . . . S LINE=" "_RCPARAM "RTN","RCDPESP8",51,0) . . . I $L(LINE_" ("_RCDET_")")>62 S SPLIT=1 "RTN","RCDPESP8",52,0) . . . I 'SPLIT D ; "RTN","RCDPESP8",53,0) . . . . I RCDET'="" S LINE=LINE_" ("_RCDET_")" "RTN","RCDPESP8",54,0) . . . . S LINE=LINE_$J("",62-$L(LINE))_" "_$J(RCOLD,8)_" "_$J(RCNEW,8) "RTN","RCDPESP8",55,0) . . . S ^TMP($J,"RCDPESP8",RCSEQ)=LINE "RTN","RCDPESP8",56,0) . . . I SPLIT D ; "RTN","RCDPESP8",57,0) . . . . S RCSEQ=RCSEQ+1 "RTN","RCDPESP8",58,0) . . . . S LINE=" "_$E(RCDET,1,58) "RTN","RCDPESP8",59,0) . . . . S LINE=LINE_$J("",62-$L(LINE))_" "_$J(RCOLD,8)_" "_$J(RCNEW,8) "RTN","RCDPESP8",60,0) . . . . S ^TMP($J,"RCDPESP8",RCSEQ)=LINE "RTN","RCDPESP8",61,0) I 'RCLM D ; "RTN","RCDPESP8",62,0) . D OUTPUT "RTN","RCDPESP8",63,0) E D ; "RTN","RCDPESP8",64,0) . D HEAD "RTN","RCDPESP8",65,0) . S LMHDR("TITLE")="Auto Parameter History Report" "RTN","RCDPESP8",66,0) . S LMHDR(1)=RCHDR(2) "RTN","RCDPESP8",67,0) . S LMHDR(2)=RCHDR(3) "RTN","RCDPESP8",68,0) . S LMHDR(3)="" "RTN","RCDPESP8",69,0) . S LMHDR(4)="" "RTN","RCDPESP8",70,0) . S LMHDR(5)="" "RTN","RCDPESP8",71,0) . S LMHDR(6)=RCHDR(5) "RTN","RCDPESP8",72,0) . S LMHDR(7)=RCHDR(6) "RTN","RCDPESP8",73,0) . D LMRPT^RCDPEARL(.LMHDR,$NA(^TMP($J,"RCDPESP8"))) ; Generate ListMan display "RTN","RCDPESP8",74,0) ; "RTN","RCDPESP8",75,0) EXIT ; Exit point to clean up ^TMP "RTN","RCDPESP8",76,0) K ^TMP($J,"RCDPESP8") "RTN","RCDPESP8",77,0) Q "RTN","RCDPESP8",78,0) ; "RTN","RCDPESP8",79,0) OUTPUT ; Output printed report to screen or printer "RTN","RCDPESP8",80,0) S RCPGNUM=0 "RTN","RCDPESP8",81,0) D HEAD "RTN","RCDPESP8",82,0) S RCSEQ=0 "RTN","RCDPESP8",83,0) F S RCSEQ=$O(^TMP($J,"RCDPESP8",RCSEQ)) Q:'RCSEQ D I RCSTOP Q "RTN","RCDPESP8",84,0) . I $Y>(IOSL-3)!(RCPGNUM=0) D HDRLST^RCDPEARL(.RCSTOP,.RCHDR) I RCSTOP Q "RTN","RCDPESP8",85,0) . W !,^TMP($J,"RCDPESP8",RCSEQ) "RTN","RCDPESP8",86,0) Q "RTN","RCDPESP8",87,0) HEAD ; Print header "RTN","RCDPESP8",88,0) N LINE "RTN","RCDPESP8",89,0) S LINE="Auto Parameter History Report" "RTN","RCDPESP8",90,0) S LINE=$J("",(80-$L(LINE)\2))_LINE "RTN","RCDPESP8",91,0) S RCHDR("H")=LINE_$J("",71-$L(LINE)) "RTN","RCDPESP8",92,0) S LINE="RUN DATE: "_$$FMTE^XLFDT($$NOW^XLFDT,"2Z") "RTN","RCDPESP8",93,0) S RCHDR(2)=$J("",(80-$L(LINE)\2))_LINE "RTN","RCDPESP8",94,0) S LINE="DATE RANGE: "_$$FMTE^XLFDT(BDATE,"2DZ")_" - "_$$FMTE^XLFDT(EDATE,"2DZ") "RTN","RCDPESP8",95,0) S RCHDR(3)=$J("",(80-$L(LINE)\2))_LINE "RTN","RCDPESP8",96,0) S RCHDR(4)="" "RTN","RCDPESP8",97,0) S LINE="Date/Time Edited User"_$J("",48)_"Values" "RTN","RCDPESP8",98,0) S RCHDR(5)=LINE "RTN","RCDPESP8",99,0) S LINE=" Parameter"_$J("",57)_"Old New" "RTN","RCDPESP8",100,0) S RCHDR(6)=LINE "RTN","RCDPESP8",101,0) S RCHDR(7)=$TR($J("",80)," ","=") "RTN","RCDPESP8",102,0) S RCHDR("XECUTE")="S RCPGNUM=RCPGNUM+1,RCHDR(1)=RCHDR(""H"")_""Page: ""_RCPGNUM" "RTN","RCDPESP8",103,0) S RCDISPTY=$S(RCLM:1,1:0) "RTN","RCDPESP8",104,0) S RCHDR(0)=7 "RTN","RCDPESP8",105,0) ; "RTN","RCDPESP8",106,0) S VALMHDR(1)=RCHDR("H") "RTN","RCDPESP8",107,0) S VALMHDR(2)=RCHDR(3) "RTN","RCDPESP8",108,0) S VALMHDR(3)="" "RTN","RCDPESP8",109,0) S VALMHDR(4)=RCHDR(5) "RTN","RCDPESP8",110,0) S VALMHDR(5)=RCHDR(6) "RTN","RCDPESP8",111,0) Q "RTN","RCDPESP8",112,0) ; "RTN","RCDPESP8",113,0) PROMPTS(BDATE,EDATE,RCLM,RCXL) ; Propmt for report Parameters "RTN","RCDPESP8",114,0) ; Input: None "RTN","RCDPESP8",115,0) ; Output: BDATE - Start date for report in FileMan internal format "RTN","RCDPESP8",116,0) ; EDATE - End date for report in Fileman internal format "RTN","RCDPESP8",117,0) ; RCLM - Boolean flag - display in ListMan "RTN","RCDPESP8",118,0) ; Returns: -1 Quit without running report "RTN","RCDPESP8",119,0) ; 1 Continue "RTN","RCDPESP8",120,0) ; "RTN","RCDPESP8",121,0) N DIR,RETURN,Y "RTN","RCDPESP8",122,0) S RETURN=1 "RTN","RCDPESP8",123,0) S DIR("?")="ENTER THE DATE OF THE EARIEST PARAMETER CHANGE TO INCLUDE" "RTN","RCDPESP8",124,0) S DIR(0)="DAO^:"_DT_":APE",DIR("A")="Start Date: ",DIR("B")="T" D ^DIR K DIR "RTN","RCDPESP8",125,0) I $D(DTOUT)!$D(DUOUT)!(Y="") S RETURN=-1 G PQ "RTN","RCDPESP8",126,0) S BDATE=Y "RTN","RCDPESP8",127,0) ; "RTN","RCDPESP8",128,0) K DIR "RTN","RCDPESP8",129,0) S DIR("?")="ENTER THE DATE OF THE LATEST PARAMETER CHANGE TO INCLUDE" "RTN","RCDPESP8",130,0) S DIR("B")="T" "RTN","RCDPESP8",131,0) S DIR(0)="DAO^"_BDATE_":"_DT_":APE",DIR("A")="End Date: " D ^DIR K DIR "RTN","RCDPESP8",132,0) I $D(DTOUT)!$D(DUOUT)!(Y="") S RETURN=-1 G PQ "RTN","RCDPESP8",133,0) S EDATE=Y "RTN","RCDPESP8",134,0) ; "RTN","RCDPESP8",135,0) S RCLM=$$ASKLM^RCDPEARL() I RCLM=-1 S RETURN=-1 "RTN","RCDPESP8",136,0) PQ ; Common exit point for PROMPTS "RTN","RCDPESP8",137,0) Q RETURN "RTN","RCDPESPA") 0^24^B72015265 "RTN","RCDPESPA",1,0) RCDPESPA ;OICO/hrub - ePayment Lockbox Parameter Audit Report ;12 Oct 2018 09:59:54 "RTN","RCDPESPA",2,0) ;;4.5;Accounts Receivable;*332**;Oct 11, 2018;Build 40 "RTN","RCDPESPA",3,0) ;Per VA Directive 6402, this routine should not be modified. "RTN","RCDPESPA",4,0) ; "RTN","RCDPESPA",5,0) Q "RTN","RCDPESPA",6,0) ; "RTN","RCDPESPA",7,0) AUDPARM ; EDI Lockbox Parameters Audit Report [RCDPE PARAMETER AUDIT REPORT] "RTN","RCDPESPA",8,0) ; report logic moved from RCDPESP2, 11 October 2018 "RTN","RCDPESPA",9,0) ; report is a listing of the RCDPE PARAMETER AUDIT file (#344.7) "RTN","RCDPESPA",10,0) ; including changes to the RCDPE PARAMETER file (#344.61) "RTN","RCDPESPA",11,0) ; "RTN","RCDPESPA",12,0) ; ^TMP($T(+0)_"-AUD",$J) - storage for LIST^DIC output "RTN","RCDPESPA",13,0) ; ^TMP($J,"RCLABEL") - field labels from $$GET1^DID "RTN","RCDPESPA",14,0) ; RCDIERR - errors from LIST^DIC "RTN","RCDPESPA",15,0) ; RCDIGET - ^TMP storage for LIST^DIC "RTN","RCDPESPA",16,0) ; RCFLDS - fields for LIST^DIC "RTN","RCDPESPA",17,0) ; RCPARAM - changed parameter "RTN","RCDPESPA",18,0) ; RCPARAM("dt&tm") - date and time parameter changed "RTN","RCDPESPA",19,0) ; RCPARAM("file") - file number "RTN","RCDPESPA",20,0) ; RCPARAM("fld") - field number "RTN","RCDPESPA",21,0) ; RCPARAM("newVal") - new parameter value "RTN","RCDPESPA",22,0) ; RCPARAM("oldVal") - old parameter value "RTN","RCDPESPA",23,0) ; RCPARAM("usr") - user who changed parameter "RTN","RCDPESPA",24,0) ; RCRPRT("begDate") - report start date "RTN","RCDPESPA",25,0) ; RCRPRT("endDate") - report end date "RTN","RCDPESPA",26,0) ; RCRPRT("eXcel") - flag, output to Excel? "RTN","RCDPESPA",27,0) ; RCRPRT("hdrDate") - date/time report was run "RTN","RCDPESPA",28,0) ; RCRPRT("hdrPg#") - page counter "RTN","RCDPESPA",29,0) ; RCRPRT("hdrTyp") - type to display in header "RTN","RCDPESPA",30,0) ; RCRPRT("pgLns") - line count for page (or screen) "RTN","RCDPESPA",31,0) ; RCRPRT("typRprt") - type of report (Medical, Pharmacy, Tricare of All) "RTN","RCDPESPA",32,0) ; RCRPRT("cntr") - count of records output "RTN","RCDPESPA",33,0) ; RCSCR - screening logic for LIST^DIC "RTN","RCDPESPA",34,0) ; RCSTOP - flag, stop displaying report "RTN","RCDPESPA",35,0) ; RCTMP - one line from LIST^DIC "RTN","RCDPESPA",36,0) N %ZIS,POP,RCDIERR,RCDIGET,RCFLDS,RCIEN,RCPARAM,RCRPRT,RCSCR,RCSTOP,RCTMP,X,Y "RTN","RCDPESPA",37,0) W !!,"EDI Lockbox Parameters Audit Report",! "RTN","RCDPESPA",38,0) ; set up FileMan storage location "RTN","RCDPESPA",39,0) S RCDIGET=$NA(^TMP($T(+0)_"-AUD",$J)) K @RCDIGET,^TMP($J,"RCLABEL") "RTN","RCDPESPA",40,0) ; initialize to zero "RTN","RCDPESPA",41,0) S (RCSTOP,RCRPRT("hdrPg#"),RCRPRT("eXcel"),RCRPRT("cntr"),RCRPRT("pgLns"))=0 "RTN","RCDPESPA",42,0) ; retrieve report type (Medical, Pharmacy, or Both) "RTN","RCDPESPA",43,0) S RCRPRT("typRprt")=$$RTYPE("B") ; default is Both "RTN","RCDPESPA",44,0) Q:RCRPRT("typRprt")=-1 "RTN","RCDPESPA",45,0) ; type for header "RTN","RCDPESPA",46,0) S RCRPRT("hdrTyp")=$S(RCRPRT("typRprt")="M":"Medical",RCRPRT("typRprt")="P":"Pharmacy",1:"Both Medical&Pharmacy") "RTN","RCDPESPA",47,0) ; "RTN","RCDPESPA",48,0) S Y("dtRange")=$$DTRNG() Q:Y("dtRange")=0 "RTN","RCDPESPA",49,0) ; "RTN","RCDPESPA",50,0) S RCRPRT("begDate")=$P(Y("dtRange"),U,2),RCRPRT("endDate")=$P(Y("dtRange"),U,3) K Y "RTN","RCDPESPA",51,0) S RCRPRT("eXcel")=$$DISPTY^RCDPEM3() Q:+RCRPRT("eXcel")=-1 "RTN","RCDPESPA",52,0) ; Display capture information for Excel "RTN","RCDPESPA",53,0) I RCRPRT("eXcel") D INFO^RCDPEM6 "RTN","RCDPESPA",54,0) ;Select output device "RTN","RCDPESPA",55,0) S %ZIS="M" D ^%ZIS Q:POP U IO "RTN","RCDPESPA",56,0) ; "RTN","RCDPESPA",57,0) S RCRPRT("hdrDate")=$$FMTE^XLFDT($$NOW^XLFDT,"5S") "RTN","RCDPESPA",58,0) S RCRPRT("dtRange")=$$FMTE^XLFDT(RCRPRT("begDate"),"5D")_" - "_$$FMTE^XLFDT(RCRPRT("endDate"),"5D") "RTN","RCDPESPA",59,0) ; "RTN","RCDPESPA",60,0) S RCRPRT("endDate")=RCRPRT("endDate")+.5 "RTN","RCDPESPA",61,0) S RCSCR="I ($P(^(0),U)'<"_RCRPRT("begDate")_")&($P(^(0),U)'>"_RCRPRT("endDate")_")" "RTN","RCDPESPA",62,0) S RCFLDS="@;.04;.01I;.07;.06;.03;.05I;.02" "RTN","RCDPESPA",63,0) D LIST^DIC(344.7,,RCFLDS,"P",,,,,RCSCR,,RCDIGET,"RCDIERR") "RTN","RCDPESPA",64,0) I $D(RCDIERR) W !!,"FileMan error when collecting report data." D ASK^RCDPEARL() Q "RTN","RCDPESPA",65,0) ; "RTN","RCDPESPA",66,0) ; No changes found for date range "RTN","RCDPESPA",67,0) I '$D(@RCDIGET@("DILIST",1)) G RPTEND "RTN","RCDPESPA",68,0) ; Get Auto-Decrease parameters "RTN","RCDPESPA",69,0) S RCRPRT("medAuto")=$P($G(^RCY(344.61,1,0)),U,3) ;(#.03) AUTO-DECREASE MED ENABLED [3S] "RTN","RCDPESPA",70,0) S RCRPRT("rxAuto")=$P($G(^RCY(344.61,1,1)),U,2) ; (#1.02) AUTO-DECREASE RX ENABLED [2S] "RTN","RCDPESPA",71,0) ; Loop though changes from #344.7 "RTN","RCDPESPA",72,0) S RCIEN=0 F S RCIEN=$O(@RCDIGET@("DILIST",RCIEN)) Q:RCSTOP!'RCIEN D "RTN","RCDPESPA",73,0) . I 'RCRPRT("hdrPg#") D HDRLPR(.RCRPRT,.RCSTOP) S RCRPRT("pgLns")=9 "RTN","RCDPESPA",74,0) . Q:RCSTOP "RTN","RCDPESPA",75,0) . K RCPARAM S RCTMP=$P(@RCDIGET@("DILIST",RCIEN,0),U,2,8) "RTN","RCDPESPA",76,0) . S RCPARAM("file")=$P(RCTMP,U,6) "RTN","RCDPESPA",77,0) . Q:RCPARAM("file")=344.6 ; Excluded payers reported elswhere "RTN","RCDPESPA",78,0) . S RCPARAM("fld")=$P(RCTMP,U) ; PRCA*4.5*326 "RTN","RCDPESPA",79,0) . S RCPARAM("oldVal")=$P(RCTMP,U,3) "RTN","RCDPESPA",80,0) . S RCPARAM("newVal")=$P(RCTMP,U,4) "RTN","RCDPESPA",81,0) . ; store labels in ^TMP to avoid redundant FileMan calls "RTN","RCDPESPA",82,0) . D:'$D(^TMP($J,"RCLABEL",RCPARAM("file"),RCPARAM("fld"))) "RTN","RCDPESPA",83,0) .. S ^TMP($J,"RCLABEL",RCPARAM("file"),RCPARAM("fld"))=$$GET1^DID(RCPARAM("file"),RCPARAM("fld"),,"LABEL") "RTN","RCDPESPA",84,0) . S RCPARAM=^TMP($J,"RCLABEL",RCPARAM("file"),RCPARAM("fld")) "RTN","RCDPESPA",85,0) . Q:'$$TYPMTCH(.RCRPRT,RCPARAM) "RTN","RCDPESPA",86,0) . S RCRPRT("cntr")=RCRPRT("cntr")+1 ; count records listed "RTN","RCDPESPA",87,0) . I RCPARAM("file")=344.61,RCPARAM("fld")=.11 S RCPARAM="AUTO-DECREASE MED NOPAY ENABLED" ; PRCA*4.5*326 "RTN","RCDPESPA",88,0) . I RCPARAM("file")=344.61,RCPARAM("fld")=.12 S RCPARAM="AUTO-DECREASE MED DAYS (NO-PAY)" ; PRCA*4.5*326 "RTN","RCDPESPA",89,0) . S X=$P(RCTMP,U,2) ; date&time "RTN","RCDPESPA",90,0) . S RCPARAM("dt&tm")=$S(RCRPRT("eXcel"):$TR($$FMTE^XLFDT(X),"@"," "),1:$$FMTE^XLFDT(X,"2SZ")) "RTN","RCDPESPA",91,0) . S RCPARAM("usr")=$P(RCTMP,U,5),RCPARAM("oldVal")=$P(RCTMP,U,3),RCPARAM("newVal")=$P(RCTMP,U,4) "RTN","RCDPESPA",92,0) . ; Next line - added EDI claim auto-decrease no-pay parameter field .08 - PRCA*4.5*326 "RTN","RCDPESPA",93,0) . I (RCPARAM("fld")=.02)!(RCPARAM("fld")=1.01)!(RCPARAM("fld")=.08) D "RTN","RCDPESPA",94,0) .. I RCPARAM("file")=344.62 S RCPARAM=RCPARAM_" ("_$S($P(RCTMP,U,7)'="":$P($G(^RCY(RCPARAM("file"),$P(RCTMP,U,7),0)),U,1),1:"ERR")_")" "RTN","RCDPESPA",95,0) .. S RCPARAM("oldVal")=$S(+$P(RCTMP,U,3)=0:"No",+$P(RCTMP,U,3)=1:"Yes",1:"Err") "RTN","RCDPESPA",96,0) .. S RCPARAM("newVal")=$S(+$P(RCTMP,U,4)=0:"No",+$P(RCTMP,U,4)=1:"Yes",1:"Err") "RTN","RCDPESPA",97,0) . ; Next line - added EDI claim auto-audit parameter fields - PRCA*4.5*321 "RTN","RCDPESPA",98,0) . I (RCPARAM("fld")=.03)!(RCPARAM("fld")=.11)!(RCPARAM("fld")=7.05)!(RCPARAM("fld")=7.06)!(RCPARAM("fld")=7.07)!(RCPARAM("fld")=7.08)!(RCPARAM("fld")=7.09) D "RTN","RCDPESPA",99,0) .. S RCPARAM("oldVal")=$S($P(RCTMP,U,3):"Yes",1:"No") "RTN","RCDPESPA",100,0) .. S RCPARAM("newVal")=$S($P(RCTMP,U,4):"Yes",1:"No") "RTN","RCDPESPA",101,0) . ; Next line - added EDI claim auto-decrease no-pay parameter field .12 - PRCA*4.5*326 "RTN","RCDPESPA",102,0) . I (RCPARAM("file")=344.62)&((RCPARAM("fld")=.12)!(RCPARAM("fld")=.06)) D "RTN","RCDPESPA",103,0) .. S RCPARAM=RCPARAM_" ("_$S($P(RCTMP,U,7)'="":$P($G(^RCY(RCPARAM("file"),$P(RCTMP,U,7),0)),U,1),1:"ERR")_")" "RTN","RCDPESPA",104,0) . ; if null set to hyphen "RTN","RCDPESPA",105,0) . F X="oldVal","newVal" S:'$L(RCPARAM(X)) RCPARAM(X)="-" "RTN","RCDPESPA",106,0) . I 'RCRPRT("eXcel") D "RTN","RCDPESPA",107,0) .. S Y=$$PAD(RCPARAM,33)_$$PAD(RCPARAM("dt&tm"),19)_$$PAD(RCPARAM("oldVal"),5)_$$PAD(RCPARAM("newVal"),5)_RCPARAM("usr") "RTN","RCDPESPA",108,0) .. W !,$E(Y,1,IOM) S RCRPRT("pgLns")=RCRPRT("pgLns")+1 "RTN","RCDPESPA",109,0) .. I '(RCRPRT("pgLns")<(IOSL-2)) D HDRLPR(.RCRPRT,.RCSTOP) Q:RCSTOP S RCRPRT("pgLns")=9 "RTN","RCDPESPA",110,0) . I RCRPRT("eXcel") W !,RCPARAM_U_RCPARAM("dt&tm")_U_RCPARAM("oldVal")_U_RCPARAM("newVal")_U_RCPARAM("usr") "RTN","RCDPESPA",111,0) ; "RTN","RCDPESPA",112,0) RPTEND ; end of report "RTN","RCDPESPA",113,0) I 'RCSTOP,'RCRPRT("cntr") D "RTN","RCDPESPA",114,0) . D HDRLPR(.RCRPRT,.RCSTOP) "RTN","RCDPESPA",115,0) . W !," * No PARAMETER AUDIT entries to report. *",! "RTN","RCDPESPA",116,0) ; "RTN","RCDPESPA",117,0) I 'RCSTOP W !!,$$ENDORPRT^RCDPEARL,! "RTN","RCDPESPA",118,0) U IO(0) D ^%ZISC "RTN","RCDPESPA",119,0) I 'RCSTOP,'$G(ZTSK),($E(IOST,1,2)="C-") D ; must have user "RTN","RCDPESPA",120,0) . N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y "RTN","RCDPESPA",121,0) . S DIR("A")="Press enter to continue: " "RTN","RCDPESPA",122,0) . S DIR(0)="EA" D ^DIR "RTN","RCDPESPA",123,0) ; "RTN","RCDPESPA",124,0) K @RCDIGET,^TMP($J,"RCLABEL") ; clean up "RTN","RCDPESPA",125,0) ; "RTN","RCDPESPA",126,0) Q "RTN","RCDPESPA",127,0) ; "RTN","RCDPESPA",128,0) HDRLPR(RCRPRT,RCSTOP) ; Report header Lockbox Parameter Report "RTN","RCDPESPA",129,0) ; RCRPRT("eXcel") - if true output for Excel "RTN","RCDPESPA",130,0) ; RCRPRT("hdrPg#") - page count, passed by ref. "RTN","RCDPESPA",131,0) ; RCSTOP - report exit flag "RTN","RCDPESPA",132,0) ; RCRPRT("typRprt") - Type of report to run "RTN","RCDPESPA",133,0) ; "RTN","RCDPESPA",134,0) I RCRPRT("eXcel") D Q ; Excel header for PARAMETER AUDITS "RTN","RCDPESPA",135,0) . Q:RCRPRT("hdrPg#") "RTN","RCDPESPA",136,0) . W !,"PARAMETER^DATE/TIME EDITED^OLD VALUE^NEW VALUE^USER" "RTN","RCDPESPA",137,0) . S RCRPRT("hdrPg#")=1 ; only print once "RTN","RCDPESPA",138,0) ; "RTN","RCDPESPA",139,0) I 'RCRPRT("eXcel") D "RTN","RCDPESPA",140,0) . I RCRPRT("hdrPg#") D ASK^RCDPEARL(.RCSTOP) Q:RCSTOP "RTN","RCDPESPA",141,0) . W @IOF "RTN","RCDPESPA",142,0) . S RCRPRT("hdrPg#")=RCRPRT("hdrPg#")+1 "RTN","RCDPESPA",143,0) . W $$CNTR("EDI Lockbox Parameter Audit Report"),?IOM-8,"Page: "_RCRPRT("hdrPg#") "RTN","RCDPESPA",144,0) . W !,$$CNTR("RUN DATE: "_RCRPRT("hdrDate")) "RTN","RCDPESPA",145,0) . W !,$$CNTR("DATE RANGE: "_RCRPRT("dtRange")) "RTN","RCDPESPA",146,0) . W !,$$CNTR("REPORT TYPE: "_RCRPRT("hdrTyp")) "RTN","RCDPESPA",147,0) . W !!,"LOCKBOX PARAMETER UPDATES" "RTN","RCDPESPA",148,0) . W !,"-------------------------- Values" "RTN","RCDPESPA",149,0) . W !,"Parameter Date/Time Edited Old New User" "RTN","RCDPESPA",150,0) . W !,$TR($J("",IOM-1)," ","=") ; row of equal signs "RTN","RCDPESPA",151,0) Q "RTN","RCDPESPA",152,0) ; "RTN","RCDPESPA",153,0) GETPAYER() ; GET THE PAYER NAME + PAYER ID "RTN","RCDPESPA",154,0) N RCIEN,RCPAYR "RTN","RCDPESPA",155,0) S RCIEN=$P(RCTMP,U,6) "RTN","RCDPESPA",156,0) I '$D(^RCY(344.6,RCIEN)) Q "" "RTN","RCDPESPA",157,0) S RCPAYR=$$GET1^DIQ(344.6,RCIEN_",",.01)_" "_$$GET1^DIQ(344.6,RCIEN_",",.02) "RTN","RCDPESPA",158,0) Q RCPAYR "RTN","RCDPESPA",159,0) ; "RTN","RCDPESPA",160,0) ; "RTN","RCDPESPA",161,0) CNTR(TXT) ; center TXT "RTN","RCDPESPA",162,0) Q $J("",IOM-$L(TXT)\2)_TXT "RTN","RCDPESPA",163,0) ; "RTN","RCDPESPA",164,0) DTRNG() ; function, returns date range for the report "RTN","RCDPESPA",165,0) N RCEND,RCSTART "RTN","RCDPESPA",166,0) D DATES(.RCSTART,.RCEND) "RTN","RCDPESPA",167,0) Q:RCSTART=-1 0 "RTN","RCDPESPA",168,0) Q:RCSTART "1^"_RCSTART_"^"_RCEND "RTN","RCDPESPA",169,0) Q:'RCSTART "0^^" "RTN","RCDPESPA",170,0) Q 0 "RTN","RCDPESPA",171,0) ; "RTN","RCDPESPA",172,0) DATES(BDATE,EDATE) ; Get a date range, both values passed by ref. "RTN","RCDPESPA",173,0) N DIR,DTOUT,DUOUT,X,Y "RTN","RCDPESPA",174,0) S (BDATE,EDATE)=0 "RTN","RCDPESPA",175,0) S DIR("?")="Enter the earliest AUDIT DATE to include on the report" "RTN","RCDPESPA",176,0) S DIR(0)="DAO^:"_DT_":APE",DIR("A")="Report start date: " D ^DIR K DIR "RTN","RCDPESPA",177,0) I $D(DTOUT)!$D(DUOUT)!(Y="") S BDATE=-1 Q "RTN","RCDPESPA",178,0) S BDATE=Y K DIR,X,Y "RTN","RCDPESPA",179,0) S DIR("?")="Enter the latest AUDIT DATE to include on the report" "RTN","RCDPESPA",180,0) S DIR(0)="DAO^"_BDATE_":"_DT_":APE",DIR("A")="Report end date: ",DIR("B")=$$FMTE^XLFDT(DT) "RTN","RCDPESPA",181,0) D ^DIR K DIR "RTN","RCDPESPA",182,0) I $D(DTOUT)!$D(DUOUT)!(Y="") S BDATE=-1 Q "RTN","RCDPESPA",183,0) S EDATE=Y "RTN","RCDPESPA",184,0) Q "RTN","RCDPESPA",185,0) ; "RTN","RCDPESPA",186,0) RTYPE(DEF) ; type of information to display "RTN","RCDPESPA",187,0) ; Input: DEF - default value "RTN","RCDPESPA",188,0) ; Returns: "RTN","RCDPESPA",189,0) ; M - Medical, P - Pharmacy, B - Both, -1 - ^ or timed out "RTN","RCDPESPA",190,0) N DA,DIR,DTOUT,DUOUT,X,Y,DIRUT,DIROUT "RTN","RCDPESPA",191,0) S DIR("?")="Enter the type of information to display on the report." "RTN","RCDPESPA",192,0) S DIR(0)="SA^M:Medical;P:Pharmacy;B:Both" "RTN","RCDPESPA",193,0) S DIR("A")="(M)edical, (P)harmacy, B(oth): " "RTN","RCDPESPA",194,0) S DIR("B")=$S($G(DEF)'="":DEF,1:"Both") "RTN","RCDPESPA",195,0) D ^DIR "RTN","RCDPESPA",196,0) K DIR "RTN","RCDPESPA",197,0) I $D(DTOUT)!$D(DUOUT) Q -1 "RTN","RCDPESPA",198,0) S:Y="" Y="A" "RTN","RCDPESPA",199,0) Q $E(Y) "RTN","RCDPESPA",200,0) ; "RTN","RCDPESPA",201,0) TYPMTCH(RCRPRT,RCPARAM) ; Boolean function, does value match report type? "RTN","RCDPESPA",202,0) ; Return 1 if valid to print, else zero "RTN","RCDPESPA",203,0) Q:RCRPRT("typRprt")="B" 1 ; both types "RTN","RCDPESPA",204,0) Q:RCPARAM["TRIC" 1 ; Tricare change, on both reports "RTN","RCDPESPA",205,0) ; "RTN","RCDPESPA",206,0) Q:(RCRPRT("typRprt")="M")&(RCPARAM["MED") 1 ; Medical Parameters "RTN","RCDPESPA",207,0) Q:(RCRPRT("typRprt")="P")&((RCPARAM["RX")!(RCPARAM["PHARM")) 1 ; Pharmacy parameters "RTN","RCDPESPA",208,0) ; evaluate if auto-decrease on "RTN","RCDPESPA",209,0) ; RCRPRT("medAuto") and RCRPRT("rxAuto") carried in symbol table "RTN","RCDPESPA",210,0) Q:(RCRPRT("typRprt")="M")&($G(RCRPRT("medAuto")))&(RCPARAM["DECREASE") 1 ; Auto-decrease for med is on "RTN","RCDPESPA",211,0) Q:(RCRPRT("typRprt")="P")&($G(RCRPRT("rxAuto")))&(RCPARAM["DECREASE") 1 ; Auto-decrease for pharmacy "RTN","RCDPESPA",212,0) Q 0 "RTN","RCDPESPA",213,0) ; "RTN","RCDPESPA",214,0) PAD(A,N) ; pad A with N spaces "RTN","RCDPESPA",215,0) S A=A_" " ; always add 1 space "RTN","RCDPESPA",216,0) Q:'($L(A)0:+DUP,1:RCXMG) "RTN","RCDPESR2",88,0) .S ^TMP($J,"RCDPEOB","HDR")=$G(^RCY(344.5,RCTDA,2,1,0)) "RTN","RCDPESR2",89,0) .I $G(RCNEWTRC)'="" S $P(^TMP($J,"RCDPEOB","HDR"),U,8)=RCNEWTRC ; PRCA*4.5*332 Update EEOB with -DUP trace# "RTN","RCDPESR2",90,0) .I $P(^TMP($J,"RCDPEOB","HDR"),U)["XFR",'$P($G(^RCY(344.5,RCTDA,0)),U,14) D "RTN","RCDPESR2",91,0) ..D SENDACK^RCDPESR5(RCTDA,1) "RTN","RCDPESR2",92,0) ..S DR=".14////1",DIE="^RCY(344.5,",DA=RCTDA D ^DIE "RTN","RCDPESR2",93,0) ; "RTN","RCDPESR2",94,0) I RCFILE=4 D "RTN","RCDPESR2",95,0) .S RCGBL=$NA(^RCY(344.4,+RCTDA,1,+$P(RCTDA,";",2),1)) "RTN","RCDPESR2",96,0) .S RCMNUM=$P($G(^RCY(344.4,+RCTDA,0)),U,12),RCXMG=$P($G(^(0)),U,12) "RTN","RCDPESR2",97,0) .S ^TMP($J,"RCDPEOB","HDR")=$G(^RCY(344.4,+RCTDA,1,+$P(RCTDA,";",2),1,1,0)) "RTN","RCDPESR2",98,0) ; "RTN","RCDPESR2",99,0) S RCPAYER=$P($G(^TMP($J,"RCDPEOB","HDR")),U,6) "RTN","RCDPESR2",100,0) S RCDPBNPI=$P($G(^TMP($J,"RCDPEOB","HDR")),U,18) "RTN","RCDPESR2",101,0) ; "RTN","RCDPESR2",102,0) ;srv dates "RTN","RCDPESR2",103,0) S RCSD=$NA(^TMP($J,"RCSRVDT")) K @RCSD "RTN","RCDPESR2",104,0) S RCSTART=0 ; PRCA*4.5*321 "RTN","RCDPESR2",105,0) N CP5 S CP5="",RC=1,C5=0 ;retrofit 264 into 269 "RTN","RCDPESR2",106,0) F S RC=$O(@RCGBL@(RC)) Q:'RC S RC0=$G(^(RC,0)) D "RTN","RCDPESR2",107,0) .I RC0<5 Q "RTN","RCDPESR2",108,0) .;Statement Start Date - 05 Record is mandatory "RTN","RCDPESR2",109,0) .I +RC0=5 S RCSTART=+$P(RC0,U,9) ; PRCA*4.5*321 "RTN","RCDPESR2",110,0) .I +RC0=5 S C5=RC,CP5=$P(RC0,U,2) Q ;retrofit 264 into 269 "RTN","RCDPESR2",111,0) .; service date for possible ECME# matching "RTN","RCDPESR2",112,0) .; PRCA*4.3*321 BEGIN "RTN","RCDPESR2",113,0) .I +RC0=40,$$VALECME^BPSUTIL2(CP5),C5,'$D(@RCSD@(C5)) D "RTN","RCDPESR2",114,0) ..I $P(RC0,U,19) S @RCSD@(C5)=+$P(RC0,U,19) Q "RTN","RCDPESR2",115,0) ..; If service date not present use statement start date instead "RTN","RCDPESR2",116,0) ..S:RCSTART @RCSD@(C5)=RCSTART "RTN","RCDPESR2",117,0) ; PRCA*4.5*321 END "RTN","RCDPESR2",118,0) ; "RTN","RCDPESR2",119,0) S RC=1,(RCCT,RCCT1,RCX,REFORM)=0,RCBILL="" "RTN","RCDPESR2",120,0) S RCERR1=$NA(^TMP("RCERR1",$J)) K @RCERR1 "RTN","RCDPESR2",121,0) F S RC=$O(@RCGBL@(RC)) Q:'RC S RC0=$G(^(RC,0)) D "RTN","RCDPESR2",122,0) .I RCFILE=5,+RC0=1 D Q "RTN","RCDPESR2",123,0) ..S ^TMP($J,"RCDPEOB","CONTACT")=RC0 "RTN","RCDPESR2",124,0) .; "RTN","RCDPESR2",125,0) .I RCFILE=5,+RC0=2 D Q "RTN","RCDPESR2",126,0) ..S RCX=RCX+1,^TMP($J,"RCDPEOB","ADJ",RCX)=RC0 "RTN","RCDPESR2",127,0) .I RCFILE=5,+RC0=3 D Q ; Adding logic for line type 03,Patch 269,DWA "RTN","RCDPESR2",128,0) ..S $P(^TMP($J,"RCDPEOB","ADJ",RCX),U,5)=$P(RC0,U,2) "RTN","RCDPESR2",129,0) .; "RTN","RCDPESR2",130,0) .I +RC0=5 S RCCT=RCCT+1,RCCT1=0 D "RTN","RCDPESR2",131,0) ..S REFORM=0,ECMENUM="" I $$VALECME^BPSUTIL2($P(RC0,U,2)) S ECMENUM=$P(RC0,U,2) "RTN","RCDPESR2",132,0) ..S Z=$$BILL^RCDPESR1($P(RC0,U,2),$G(@RCSD@(RC)),.RCIB) ; look up claim ien by claim# or by ECME# "RTN","RCDPESR2",133,0) ..I Z S RCBILL=$P($G(^PRCA(430,Z,0)),U) I RCBILL'="",RCBILL'=$P(RC0,U,2) S REFORM=1,$P(RC0,U,2)=RCBILL "RTN","RCDPESR2",134,0) ..S RCBILL=$P(RC0,U,2) "RTN","RCDPESR2",135,0) ..S Z=$S(Z>0:$S($G(RCIB):Z,1:-1),1:-1) "RTN","RCDPESR2",136,0) ..S ^TMP($J,"RCDP-EOB",RCCT,0)=Z_U_RCBILL_U_$G(@RCSD@(RC))_U_ECMENUM "RTN","RCDPESR2",137,0) ..S $P(^TMP($J,"RCDPEOB",RCCT,"EOB"),U,5)=$P(RC0,U,3)_","_$P(RC0,U,4)_" "_$P(RC0,U,5) ;Save pt nm "RTN","RCDPESR2",138,0) ..I Z>0 S Q=+$P($G(^PRCA(430,Z,0)),U,9) I $P($G(^RCD(340,Q,0)),U)["DIC(36," S $P(^TMP($J,"RCDPEOB",RCCT,"EOB"),U,3)=+^RCD(340,Q,0) ;Save ins co "RTN","RCDPESR2",139,0) .; "RTN","RCDPESR2",140,0) .I +RC0>5,REFORM S $P(RC0,U,2)=RCBILL ; "RTN","RCDPESR2",141,0) .I +RC0=10 D ;Save amt pd/billed, rev flg "RTN","RCDPESR2",142,0) ..S $P(^TMP($J,"RCDPEOB",RCCT,"EOB"),U,2)=$S(+$P(RC0,U,11):$J($P(RC0,U,11)/100,"",2),1:0),$P(^TMP($J,"RCDPEOB",RCCT,"EOB"),U,6)=$J($P(RC0,U,11),"",2) "RTN","RCDPESR2",143,0) ..I $P(RC0,U,6)="Y"!($P(RC0,U,7)=22) S $P(^TMP($J,"RCDPEOB",RCCT,"EOB"),U,4)=1 "RTN","RCDPESR2",144,0) ..S $P(^TMP($J,"RCDPEOB",RCCT,"EOB"),U,10,14)=RCDPBNPI_U_$P(RC0,U,16,19) "RTN","RCDPESR2",145,0) .I +RC0=11 D ; Save Rendering Provider information from new style message "RTN","RCDPESR2",146,0) ..S $P(^TMP($J,"RCDPEOB",RCCT,"EOB"),U,10,14)=RCDPBNPI_U_$P(RC0,U,3,6) "RTN","RCDPESR2",147,0) ..; End save of Rendering Provider "RTN","RCDPESR2",148,0) .I RCBILL=$P(RC0,U,2) S RCCT1=RCCT1+1,^TMP($J,"RCDP-EOB",RCCT,RCCT1,0)=RC0 "RTN","RCDPESR2",149,0) ; "RTN","RCDPESR2",150,0) S RCSTAR=$TR($J("",15)," ","*"),RCET=RCSTAR_"ERROR/WARNING EEOB DETAIL SEQ #" "RTN","RCDPESR2",151,0) S RCCT=0 F S RCCT=$O(^TMP($J,"RCDP-EOB",RCCT)) Q:'RCCT S RCIFN=+$G(^(RCCT,0)),RCBILL=$P($G(^(0)),U,2),^TMP($J,"RCDPEOB",RCCT)=$G(^TMP($J,"RCDP-EOB",RCCT,0)) D "RTN","RCDPESR2",152,0) .S RCEOB=-1,RCEOBD="" "RTN","RCDPESR2",153,0) .I $S(RCIFN>0:$P(^PRCA(430.3,+$P($G(^PRCA(430,+RCIFN,0)),U,8),0),U,3)'=102,RCIFN'>0&($G(DUP)'>0):1,1:0) D "RTN","RCDPESR2",154,0) ..S @RCERR1@(RCCT)=" ",@RCERR1@(RCCT,1)=RCET_RCCT_RCSTAR "RTN","RCDPESR2",155,0) ..S @RCERR1@(RCCT,2)="Bill "_RCBILL_" is"_$S(RCIFN>0:" not in an ACTIVE status in your A/R",1:"n't valid/wasn't found so its detail wasn't stored in IB") "RTN","RCDPESR2",156,0) ..S:RCFILE=5 @RCERR1@(RCCT,"*")=@RCERR1@(RCCT,2) "RTN","RCDPESR2",157,0) ..S @RCERR1@(RCCT,3)=" The reported amount paid on this bill was: "_$P(^TMP($J,"RCDPEOB",RCCT,"EOB"),U,2) "RTN","RCDPESR2",158,0) ..I RCIFN'>0 D "RTN","RCDPESR2",159,0) ...S @RCERR1@(RCCT,4)=" If the bill is not for your site, it must be transferred to the" "RTN","RCDPESR2",160,0) ...S @RCERR1@(RCCT,5)=" correct site and manually adjusted in your AR." "RTN","RCDPESR2",161,0) ...S @RCERR1@(RCCT,6)=" You can perform this transfer using EDI Lockbox ERA/EEOB exception process." "RTN","RCDPESR2",162,0) ...S @RCERR1@(RCCT,7)=" " "RTN","RCDPESR2",163,0) ..D DISP1^RCDPESR5(RCCT,1) "RTN","RCDPESR2",164,0) ..S Q=0 F S Q=$O(^TMP($J,"RCDP-EOB",RCCT,Q)) Q:'Q S ^TMP($J,"RCDPEOB",RCCT,Q)=$G(^TMP($J,"RCDP-EOB",RCCT,Q,0)) "RTN","RCDPESR2",165,0) ..S ^TMP($J,"RCDPEOB",RCCT)=^TMP($J,"RCDP-EOB",RCCT,0) M ^TMP($J,"RCDPEOB",RCCT,"ERR")=@RCERR1@(RCCT) "RTN","RCDPESR2",166,0) ..I RCFILE=5 D ;Store err if trans-in failed "RTN","RCDPESR2",167,0) ...N RCE,RC,DIE,X,Y,DA,DR "RTN","RCDPESR2",168,0) ...S RCE(1)=$$FMTE^XLFDT($$NOW^XLFDT(),2)_" "_$G(@RCERR1@(RCCT,"*")) "RTN","RCDPESR2",169,0) ...S RCE(2)=" ",RCFILED=0 "RTN","RCDPESR2",170,0) ...D WP^DIE(344.5,RCTDA_",",5,"A","RCE") "RTN","RCDPESR2",171,0) .I RCIFN>0 D "RTN","RCDPESR2",172,0) ..N RCDUPEOB,RCALLDUP "RTN","RCDPESR2",173,0) ..;Chk rec exists "RTN","RCDPESR2",174,0) ..S RCDUPEOB=0 "RTN","RCDPESR2",175,0) ..S RCEOB=$$DUP^RCDPESR3(RCMNUM,RCIFN,$P($G(^TMP($J,"RCDPEOB",RCCT,"EOB")),U,2),$P($G(^TMP($J,"RCDPEOB",RCCT,"EOB")),U,6)) ;Same msg for update? "RTN","RCDPESR2",176,0) ..I RCEOB,$P(RCEOB,U,2) S RCEOB=0 ;If chksum exists, let below check it "RTN","RCDPESR2",177,0) ..S ^TMP($J,"RCDP-EOB",RCCT,.5,0)="835ERA" ;Needed - checksum "RTN","RCDPESR2",178,0) ..S RCALLDUP=$$DUP^IBCEOB("^TMP("_$J_",""RCDP-EOB"","_RCCT_")",RCIFN) "RTN","RCDPESR2",179,0) ..I $S(RCALLDUP:1,RCEOB:$G(DUP)'>0,1:0) D "RTN","RCDPESR2",180,0) ...S RCDUPEOB=1 "RTN","RCDPESR2",181,0) ...D DUPREC^RCDPESR6(RCET,RCCT,RCSTAR,RCFILE,RCALLDUP,RCEOB,RCBILL,.RCDUPEOB) "RTN","RCDPESR2",182,0) ...S:RCALLDUP RCEOBD=RCALLDUP "RTN","RCDPESR2",183,0) ..;Add stub to 361.1 "RTN","RCDPESR2",184,0) ..I 'RCDUPEOB S RCEOB=+$$ADD3611^IBCEOB(RCMNUM,"","",RCIFN,1,"^TMP("_$J_",""RCDP-EOB"","_RCCT_")") ;IA 4042 "RTN","RCDPESR2",185,0) ..K ^TMP($J,"RCDP-EOB",RCCT,.5,0) "RTN","RCDPESR2",186,0) ..I RCEOB<0 D:$G(DUP)'>0 Q "RTN","RCDPESR2",187,0) ...S @RCERR1@(RCCT)=" ",^(RCCT,1)=RCET_RCCT_RCSTAR,RCFILED=0 "RTN","RCDPESR2",188,0) ...S @RCERR1@(RCCT,2)="Error - EEOB detail not added to IB for bill "_RCBILL,$P(^TMP($J,"RCDPEOB",RCCT,"EOB"),U)="" "RTN","RCDPESR2",189,0) ...S:RCFILE=5 @RCERR1@(RCCT,"*")=@RCERR1@(RCCT,2) "RTN","RCDPESR2",190,0) ...D DISP1^RCDPESR5(RCCT,1) "RTN","RCDPESR2",191,0) ...S Q=0 F S Q=$O(^TMP($J,"RCDP-EOB",RCCT,Q)) Q:'Q S ^TMP($J,"RCDPEOB",RCCT,Q)=$G(^TMP($J,"RCDP-EOB",RCCT,Q,0)) "RTN","RCDPESR2",192,0) ...S ^TMP($J,"RCDPEOB",RCCT)=^TMP($J,"RCDP-EOB",RCCT,0) M ^TMP($J,"RCDPEOB",RCCT,"ERR")=@RCERR1@(RCCT) "RTN","RCDPESR2",193,0) ..;Upd 361.1, needs ^TMP($J,"RCDPEOB","HDR" and $J,"RCDP-EOB" "RTN","RCDPESR2",194,0) ..I RCDUPEOB'<0 S RCNOUPD=0 D UPD3611^IBCEOB(RCEOB,RCCT,1) "RTN","RCDPESR2",195,0) ..;errors in ^TMP("RCDPERR-EOB",$J "RTN","RCDPESR2",196,0) ..I $O(^TMP("RCDPERR-EOB",$J,0)) D ERRUPD^IBCEOB(RCEOB,"RCDPERR-EOB") "RTN","RCDPESR2",197,0) ..S $P(^TMP($J,"RCDPEOB",RCCT,"EOB"),U)=$S('$G(RCEOBD):RCEOB,1:RCEOBD) "RTN","RCDPESR2",198,0) .K ^TMP("RCDPERR-EOB",$J) "RTN","RCDPESR2",199,0) ; "RTN","RCDPESR2",200,0) I RCNOUPD D DUPERA^RCDPESR3($G(DUP),RCNOUPD) "RTN","RCDPESR2",201,0) I $O(@RCERR1@("")) D BULLS^RCDPESR3(RCFILE,RCTDA,$S(RCNOUPD:RCNOUPD,1:$G(DUP)),$G(RCXMG)) "RTN","RCDPESR2",202,0) K ^TMP("RCDPERR-EOB",$J),^TMP($J,"RCDP-EOB"),@RCERR1,@RCSD "RTN","RCDPESR2",203,0) D CLEAN^DILF "RTN","RCDPESR2",204,0) Q "RTN","RCDPESR6") 0^6^B60062437 "RTN","RCDPESR6",1,0) RCDPESR6 ;ALB/TMK/DWA - Server auto-update file 344.4 - EDI Lockbox ;8 Aug 2018 21:44:13 "RTN","RCDPESR6",2,0) ;;4.5;Accounts Receivable;**173,214,208,230,252,269,271,298,321,332**;Mar 20, 1995;Build 40 "RTN","RCDPESR6",3,0) ;Per VA Directive 6402, this routine should not be modified. "RTN","RCDPESR6",4,0) ; "RTN","RCDPESR6",5,0) ;Reference to $$VALECME^BPSUTIL2 supported by IA# 6139 "RTN","RCDPESR6",6,0) ; "RTN","RCDPESR6",7,0) UPD3444(RCRTOT) ; Add EOB detail to list in 344.41 for file 344.4 entry RCRTOT "RTN","RCDPESR6",8,0) ; If passed by reference, RCRTOT is returned = "" if errors "RTN","RCDPESR6",9,0) ; "RTN","RCDPESR6",10,0) N DA,DD,DIC,DIK,DLAYGO,DO,DR,RC,RC1,RC2,RCCOM1,RCCOM2,RCCT,RCDPNM,RCEOB,RCNPI1,RCNPI2,X,Y,Z "RTN","RCDPESR6",11,0) S RC=0 F S RC=$O(^TMP($J,"RCDPEOB",RC)) Q:'RC S RC1=$G(^(RC)),RC2=$G(^(RC,"EOB")),RCEOB=+RC2 D Q:'RCRTOT "RTN","RCDPESR6",12,0) . ; Update 344.41 with reference to this record if it doesn't already exist "RTN","RCDPESR6",13,0) . I RCEOB>0 Q:$D(^RCY(344.4,RCRTOT,1,"AC",RCEOB,RC)) "RTN","RCDPESR6",14,0) . I RCEOB'>0,$S($P(RC1,U,2)'="":$D(^RCY(344.4,RCRTOT,1,"AD",$P(RC1,U,2),RC)),1:0) Q "RTN","RCDPESR6",15,0) . ; Disregard ECME reject related EEOBs; ECME# can be 7 digits or 12 digits "RTN","RCDPESR6",16,0) . I RCEOB'>0,'$P(RC2,U,2),$$VALECME^BPSUTIL2($P(RC1,U,2)),$$REJECT^IBNCPDPU($P(RC1,U,2),$P(RC1,U,3)) Q "RTN","RCDPESR6",17,0) . ; "RTN","RCDPESR6",18,0) . S DA(1)=RCRTOT,X=RC,DIC="^RCY(344.4,"_DA(1)_",1,",DIC(0)="L",DLAYGO=344.41 "RTN","RCDPESR6",19,0) . S DIC("DR")=$S($G(RCEOB)>0:".02////"_RCEOB,1:".05////"_$P(RC1,U,2)_";.07////1") "RTN","RCDPESR6",20,0) . I $P(RC2,U,2)'="" S DIC("DR")=DIC("DR")_$S($L(DIC("DR")):";",1:"")_".03///"_$P(RC2,U,2) ; amt "RTN","RCDPESR6",21,0) . I $P(RC2,U,3)'="" S DIC("DR")=DIC("DR")_$S($L(DIC("DR")):";",1:"")_".04////"_$P(RC2,U,3) ; ins co "RTN","RCDPESR6",22,0) . I $P(RC2,U,4) S DIC("DR")=DIC("DR")_$S($L(DIC("DR")):";",1:"")_".14////1" ; reversal "RTN","RCDPESR6",23,0) . I $P(RC2,U,5)'="" S DIC("DR")=DIC("DR")_$S($L(DIC("DR")):";",1:"")_".15////^S X=$E($P(RC2,U,5),1,30)" ; Patient name "RTN","RCDPESR6",24,0) . ; Process Billing Prov NPI, Rendering/Servicing NPI & name "RTN","RCDPESR6",25,0) . S (RCCOM1,RCCOM2)="" "RTN","RCDPESR6",26,0) . S RCNPI1=$P(RC2,U,10),RCNPI2=$P(RC2,U,11) "RTN","RCDPESR6",27,0) . I RCNPI1'="",'$$CHKDGT^XUSNPI(RCNPI1) S RCCOM1="The Billing Provider NPI received on the 835 ("_$E(RCNPI1,1,10)_") is not a valid format." "RTN","RCDPESR6",28,0) . I RCNPI2'="",'$$CHKDGT^XUSNPI(RCNPI2) S RCCOM2="The "_$S($P(RC2,U,12)=1:"Rendering",1:"Servicing")_" NPI received on the 835 ("_$E(RCNPI2,1,10)_") is not a valid format." "RTN","RCDPESR6",29,0) . I RCCOM1="" S DIC("DR")=DIC("DR")_";.18////^S X=$P(RC2,U,10)" ;Billing Provider NPI "RTN","RCDPESR6",30,0) . I RCCOM2="" S DIC("DR")=DIC("DR")_";.19////^S X=$P(RC2,U,11)" ;Rendering Provider NPI "RTN","RCDPESR6",31,0) . S RCDPNM=$P(RC2,U,13) I $P(RC2,U,14)]"" S RCDPNM=RCDPNM_$S(RCDPNM]"":",",1:"")_$P(RC2,U,14) "RTN","RCDPESR6",32,0) . S DIC("DR")=DIC("DR")_";.2////^S X=$P(RC2,U,12);.21////^S X=RCDPNM" ; Entity Type Qualifier ^ Last name,First Name "RTN","RCDPESR6",33,0) . S DIC("DR")=DIC("DR")_";.22////^S X=RCCOM1;.23////^S X=RCCOM2" ;Comment on Billing provider^comment on rendering/servicing provider NPI "RTN","RCDPESR6",34,0) . I $$VALECME^BPSUTIL2($P(RC1,U,4)) D "RTN","RCDPESR6",35,0) .. S DIC("DR")=DIC("DR")_";.24////^S X=$P(RC1,U,4)" ;Add ECME number (if valid) PRCA*4.5*298 "RTN","RCDPESR6",36,0) . D FILE^DICN K DO,DD,DLAYGO,DIC,DIK "RTN","RCDPESR6",37,0) . S RCCT=+Y "RTN","RCDPESR6",38,0) . I RCCT<0 D Q "RTN","RCDPESR6",39,0) .. S DA=RCRTOT,DIK="^RCY(344.4," D ^DIK "RTN","RCDPESR6",40,0) .. S RCRTOT=0 "RTN","RCDPESR6",41,0) . ; If there is no IB EOB record, store the raw data in 344.411 "RTN","RCDPESR6",42,0) . I RC1'>0!(RCEOB'>0) D "RTN","RCDPESR6",43,0) .. N RCDATA,RCC,RCDA "RTN","RCDPESR6",44,0) .. S RCC=2,RCDATA(1)=$G(^TMP($J,"RCDPEOB","HDR")) "RTN","RCDPESR6",45,0) .. ; PRCA*4.5*321 - use RC in place of RCCT to allow for gaps in ERA sequence numbers (due to ECME rejects) "RTN","RCDPESR6",46,0) .. S Z=0 F S Z=$O(^TMP($J,"RCDPEOB",RC,Z)) Q:'Z S RCC=RCC+1,RCDATA(RCC)=$G(^TMP($J,"RCDPEOB",RC,Z)) "RTN","RCDPESR6",47,0) .. S RCDA(1)=RCRTOT,RCDA=RCCT "RTN","RCDPESR6",48,0) .. D WP^DIE(344.41,$$IENS^DILF(.RCDA),1,"A","RCDATA") "RTN","RCDPESR6",49,0) Q "RTN","RCDPESR6",50,0) ; "RTN","RCDPESR6",51,0) ; PRCA*4.5*332 start - 8 August 2018 "RTN","RCDPESR6",52,0) ERATOT(RC3445DA,RCERR) ;function, File ERA TOTAL rec in 344.4 from entry RC3445DA in 344.5 "RTN","RCDPESR6",53,0) ; RC3445DA = ien file 344.5 "RTN","RCDPESR6",54,0) ; Returns: NEW ien file 344.4 "RTN","RCDPESR6",55,0) ; RCERR if passed by reference, with error text "RTN","RCDPESR6",56,0) ; RCERR(1)=duplicated message "RTN","RCDPESR6",57,0) N LPXREF,RCDA,RCDUP,RCFORCE,RCRAW,RCTRACE,RCX,X,Y "RTN","RCDPESR6",58,0) S (RCERR,RCDA)="" ; returned values "RTN","RCDPESR6",59,0) S RCRAW(0)=$G(^RCY(344.5,RC3445DA,2,1,0)) "RTN","RCDPESR6",60,0) S RCRAW("Type")=$P(RCRAW(0),U),RCTRACE=$P(RCRAW(0),U,8),RCRAW("InsID")=$P(RCRAW(0),U,7),RCRAW("Payer")=$P(RCRAW(0),U,6),RCRAW("Method")=$P(RCRAW(0),U,17) "RTN","RCDPESR6",61,0) ; Need header record as first entry in field "RTN","RCDPESR6",62,0) I RCRAW("Type")'["835ERA" S RCERR="No header record found in message. An EEOB exception record was created" G ERATOTQ "RTN","RCDPESR6",63,0) ; "RTN","RCDPESR6",64,0) S RCRAW("Date")=$$FMDT^RCDPESR1($P(RCRAW(0),U,9)),RCRAW("Amount")=$J(($P(RCRAW(0),U,10)/100),0,2) "RTN","RCDPESR6",65,0) ;Elec ERA's must have a trace # and an ins co id "RTN","RCDPESR6",66,0) I RCTRACE=""!(RCRAW("InsID")="") S RCERR="Trace # or ins ID missing on ERA transaction. An EEOB exception record was created." G ERATOTQ "RTN","RCDPESR6",67,0) ; Make sure it's not already there "RTN","RCDPESR6",68,0) S (RCDUP,LPXREF)=0 "RTN","RCDPESR6",69,0) F S LPXREF=$O(^RCY(344.4,"ATRIDUP",$$UP^XLFSTR(RCTRACE),$$UP^XLFSTR(RCRAW("InsID")),LPXREF)) Q:'LPXREF D Q:RCDUP "RTN","RCDPESR6",70,0) . S LPXREF(0)=$G(^RCY(344.4,LPXREF,0)) "RTN","RCDPESR6",71,0) . I $P(LPXREF(0),U,4)=RCRAW("Date"),+$P(LPXREF(0),U,5)=+RCRAW("Amount") S RCDUP=1 "RTN","RCDPESR6",72,0) ; If ERA has a receipt and is being filed from Duplicate ERA Worklist find a new "RTN","RCDPESR6",73,0) ; unique trace number for this payer/amount/date and override duplicate check "RTN","RCDPESR6",74,0) S RCFORCE=+$$GET1^DIQ(344.5,RC3445DA_",",.15,"I") ;(#.15) DUPLICATE INDICATOR [15S] "RTN","RCDPESR6",75,0) I RCFORCE D ; create new trace # "RTN","RCDPESR6",76,0) . N DPCNTR S X=$E(RCTRACE,1,45)_"-DUP" ; 49 chars. max "RTN","RCDPESR6",77,0) . ; start with null, then add numbers until it's unique "RTN","RCDPESR6",78,0) . F DPCNTR="",1:1 Q:'$D(^RCY(344.4,"ATRIDUP",$$UP^XLFSTR(X_DPCNTR),$$UP^XLFSTR(RCRAW("InsID")))) "RTN","RCDPESR6",79,0) . ; above: "ATRIDUP" x-ref is TRACE NUMBER & INSURANCE CO ID "RTN","RCDPESR6",80,0) . S (RCTRACE,RCNEWTRC)=X_DPCNTR "RTN","RCDPESR6",81,0) ; "RTN","RCDPESR6",82,0) I '$G(RCFORCE),RCDUP,$P(LPXREF(0),U,8) D G ERATOTQ ; Receipt already exists - no update "RTN","RCDPESR6",83,0) . S RCERR="This is a duplicate ERA and has already been posted",RCERR(1)=-2 "RTN","RCDPESR6",84,0) ; "RTN","RCDPESR6",85,0) I '$G(RCFORCE),RCDUP D G ERATOTQ ; duplicate found "RTN","RCDPESR6",86,0) . S RCERR="DUP",RCERR(1)=$S($P(LPXREF(0),U,12)'=$P($G(^RCY(344.5,RC3445DA,0)),U,11):$P(LPXREF(0),U,12),1:-1) G ERATOTQ "RTN","RCDPESR6",87,0) ; "RTN","RCDPESR6",88,0) D ; context for FileMan variables "RTN","RCDPESR6",89,0) . N DA,DD,DIC,DIE,DIK,DLAYGO,DO,DR,X,Y "RTN","RCDPESR6",90,0) . S RCX=$O(^RCY(344.4,$C(1)),-1)+1,X=0 ; create new IEN "RTN","RCDPESR6",91,0) . ; loop until no entry found "RTN","RCDPESR6",92,0) . F RCX=RCX:1 L +^RCY(344.4,RCX,0):1 D:$T Q:X ; PRCA*4.5*332 Fix duplicate number issue "RTN","RCDPESR6",93,0) . . I $D(^RCY(344.4,RCX)) L -^RCY(344.4,RCX,0) Q ; Lock first then check for existance "RTN","RCDPESR6",94,0) . . S X=RCX ; new entry # "RTN","RCDPESR6",95,0) . ; X from above will be new .01 field value "RTN","RCDPESR6",96,0) . S DIC(0)="L",DIC="^RCY(344.4,",DLAYGO=344.4 "RTN","RCDPESR6",97,0) . S DIC("DR")=".02////"_RCTRACE_";.03////"_RCRAW("InsID")_";.04////"_RCRAW("Date")_";.05////"_RCRAW("Amount")_";.06////"_$P(RCRAW(0),U,6)_";.09////0;.12////"_$P($G(^RCY(344.5,RC3445DA,0)),U,11)_";.07////"_$$NOW^XLFDT()_";.1////1" "RTN","RCDPESR6",98,0) . I RCRAW("Method")'="" S DIC("DR")=DIC("DR")_";.15////"_RCRAW("Method") "RTN","RCDPESR6",99,0) . D FILE^DICN S RCDA=$S(Y<0:"",1:+Y) ; new IEN in 344.4 "RTN","RCDPESR6",100,0) ; done filing, unlock "RTN","RCDPESR6",101,0) L -^RCY(344.4,RCX,0) "RTN","RCDPESR6",102,0) I 'RCDA D "RTN","RCDPESR6",103,0) . S RCERR="An error was encountered that prevented the adding of an ERA totals record. An EEOB exception record was created." "RTN","RCDPESR6",104,0) ; "RTN","RCDPESR6",105,0) ERATOTQ ; GOTO here or fall through "RTN","RCDPESR6",106,0) Q RCDA ; return new IEN "RTN","RCDPESR6",107,0) ; PRCA*4.5*332 end - 8 August 2018 "RTN","RCDPESR6",108,0) ; "RTN","RCDPESR6",109,0) UPDCON(RCRTOT) ; Add contact information to file 344.4 for an ERA "RTN","RCDPESR6",110,0) N DIE,DA,DR,Z,Q,X,Y,A,TYPE "RTN","RCDPESR6",111,0) S Z=$G(^TMP($J,"RCDPEOB","CONTACT")) "RTN","RCDPESR6",112,0) Q:$TR($P(Z,U,3,9),U)="" "RTN","RCDPESR6",113,0) S DA=RCRTOT,DIE="^RCY(344.4,",DR="" "RTN","RCDPESR6",114,0) ; "RTN","RCDPESR6",115,0) ; If old format do "RTN","RCDPESR6",116,0) I +$P($G(^TMP($J,"RCDPEOB","HDR")),U,16)'>0 D "RTN","RCDPESR6",117,0) . F Q=2:1:8 S DR=DR_$S(DR'="":";3.0",1:"3.0")_(Q-1)_"///"_$S($P(Z,U,Q)="":"@",1:"/"_$P(Z,U,Q)) "RTN","RCDPESR6",118,0) ; "RTN","RCDPESR6",119,0) ; If new format (5010) do "RTN","RCDPESR6",120,0) I +$P($G(^TMP($J,"RCDPEOB","HDR")),U,16)>0 D "RTN","RCDPESR6",121,0) . N CNT S CNT=0 "RTN","RCDPESR6",122,0) . I $P(Z,U,2)'="" S DR="3.01////"_$P(Z,U,2) "RTN","RCDPESR6",123,0) .I $P(Z,U,3)'="" S DR=DR_$S(DR'="":";3.02",1:"3.02")_"////"_$P(Z,U,3)_";3.03////TE",CNT=CNT+1 "RTN","RCDPESR6",124,0) .I $P(Z,U,4)'="" D "RTN","RCDPESR6",125,0) ..S:CNT=1 DR=DR_$S(DR'="":";3.04",1:"3.04")_"////"_$P(Z,U,4)_";3.05////FX" "RTN","RCDPESR6",126,0) ..S:CNT=0 DR=DR_$S(DR'="":";3.02",1:"3.02")_"////"_$P(Z,U,4)_";3.03////FX" "RTN","RCDPESR6",127,0) ..S CNT=CNT+1 "RTN","RCDPESR6",128,0) .I $P(Z,U,5)'="" D "RTN","RCDPESR6",129,0) ..S:CNT=2 DR=DR_$S(DR'="":";3.06",1:"3.06")_"////"_$P(Z,U,5)_";3.07////EM" "RTN","RCDPESR6",130,0) ..S:CNT=1 DR=DR_$S(DR'="":";3.04",1:"3.04")_"////"_$P(Z,U,5)_";3.05////EM" "RTN","RCDPESR6",131,0) ..S:CNT=0 DR=DR_$S(DR'="":";3.02",1:"3.02")_"////"_$P(Z,U,5)_";3.03////EM" "RTN","RCDPESR6",132,0) . I $P(Z,U,6)'="" S DR=DR_$S(DR'="":";5.01",1:"5.01")_"////"_$P(Z,U,6) "RTN","RCDPESR6",133,0) D ^DIE "RTN","RCDPESR6",134,0) Q "RTN","RCDPESR6",135,0) ; "RTN","RCDPESR6",136,0) UPDADJ(RCRTOT) ; Add ERA level adj data to file 344.4 "RTN","RCDPESR6",137,0) N Z,Z0,DA,DIC,DLAYGO,DR,X,Y,DO,DD "RTN","RCDPESR6",138,0) ; Remove any already there "RTN","RCDPESR6",139,0) S Z=0 F S Z=$O(^RCY(344.4,RCRTOT,2,Z)) Q:'Z S DA(1)=RCRTOT,DA=Z D ^DIK "RTN","RCDPESR6",140,0) ; "RTN","RCDPESR6",141,0) S Z=0 F S Z=$O(^TMP($J,"RCDPEOB","ADJ",Z)) Q:'Z S Z0=$G(^(Z)) D "RTN","RCDPESR6",142,0) . S DIC(0)="L",X=$P(Z0,U,3)_" ",DA(1)=RCRTOT,DIC="^RCY(344.4,"_DA(1)_",2,",DIC("DR")=$S($P(Z0,U,2)'="":".02////"_$P(Z0,U,2),1:"") "RTN","RCDPESR6",143,0) . S DIC("DR")=DIC("DR")_$S(DIC("DR")'="":";",1:"")_$S($P(Z0,U,4)'="":".03////"_$J(-$P(Z0,U,4)/100,"",2),1:"") "RTN","RCDPESR6",144,0) . S DIC("DR")=DIC("DR")_$S(DIC("DR")'="":";",1:"")_$S($P(Z0,U,5)'="":".04////"_$P(Z0,U,5),1:""),DLAYGO=344.42 "RTN","RCDPESR6",145,0) . S:$O(^RCY(344.4,RCRTOT,2,"B",X,0)) X=""""_X_"""" "RTN","RCDPESR6",146,0) . D FILE^DICN K DIC,DO,DD "RTN","RCDPESR6",147,0) Q "RTN","RCDPESR6",148,0) ; "RTN","RCDPESR6",149,0) DUPREC(RCET,RCCT,RCSTAR,RCFILE,RCALLDUP,RCEOB,RCBILL,RCDUPEOB) ; Overflow from RCDPESR2 "RTN","RCDPESR6",150,0) S ^TMP("RCERR1",$J,RCCT)=" ",^TMP("RCERR1",$J,RCCT,1)=RCET_RCCT_RCSTAR "RTN","RCDPESR6",151,0) S ^TMP("RCERR1",$J,RCCT,2)="(Warning): EEOB detail already filed for "_RCBILL_" - "_$S(RCALLDUP:"Duplicate not stored",1:"EEOB updated"),^TMP("RCERR1",$J,RCCT,3)=" " S:RCFILE=5 ^TMP("RCERR1",$J,RCCT,"*")=^TMP("RCERR1",$J,RCCT,2) "RTN","RCDPESR6",152,0) I RCALLDUP S RCEOB="",RCDUPEOB=-1 Q "RTN","RCDPESR6",153,0) S $P(^TMP($J,"RCDPEOB",RCCT,"EOB"),U)=RCEOB "RTN","RCDPESR6",154,0) Q "RTN","RCDPESR6",155,0) ; "RTN","RCDPEU1") 0^17^B121893428 "RTN","RCDPEU1",1,0) RCDPEU1 ;AITC/CJE - ELECTRONIC PAYER UTILITIES ;05-NOV-02 "RTN","RCDPEU1",2,0) ;;4.5;Accounts Receivable;**326,332**;Mar 20, 1995;Build 40 "RTN","RCDPEU1",3,0) ;Per VA Directive 6402, this routine should not be modified. "RTN","RCDPEU1",4,0) Q "RTN","RCDPEU1",5,0) SELPAY(PARAM) ; EP "RTN","RCDPEU1",6,0) ; New all purpose payer selection subroutine. Based off file 344.6 "RTN","RCDPEU1",7,0) ; Including options to include only given payer types (Medical/Pharmacy/Tricare/All) "RTN","RCDPEU1",8,0) ; and to filter selection to include only payers that have entries in file 344.4 or 344.31 "RTN","RCDPEU1",9,0) ; This subroutine may be used to replace all previous payer seletion prompts. "RTN","RCDPEU1",10,0) ; Input - PARAM array of parameters passed by reference "RTN","RCDPEU1",11,0) ; PARAM("TYPE") - Types of payers to include in the selection (optional defaults to A) "RTN","RCDPEU1",12,0) ; P - Pharmacy, T - Tricare, M - Medical (neither P nor T), A - All "RTN","RCDPEU1",13,0) ; PARAM("FILE") - Only include payers that have entries on the ERA or EFT file (optional) "RTN","RCDPEU1",14,0) ; 344.4 - ERA, 344.31 - EFT "RTN","RCDPEU1",15,0) ; PARAM("SRCH") - Search by payer name or TIN (optional defaults to N) "RTN","RCDPEU1",16,0) ; N - Payer Name, T - TIN "RTN","RCDPEU1",17,0) ; PARAM("SELC") - Seclect individual payers, or range of payers (optional defaults to S) "RTN","RCDPEU1",18,0) ; S - Selected payers, R - Range of payers "RTN","RCDPEU1",19,0) ; PARAM("DICA") - Text that will be used to prompt the user (optional) "RTN","RCDPEU1",20,0) ; defaults to "Select payer "_$S(PARAM("SRCH")="N":"name",1:"TIN") "RTN","RCDPEU1",21,0) ; "RTN","RCDPEU1",22,0) ; Output - ^TMP("RCDPEU1",$J,PAYERIEN)="" "RTN","RCDPEU1",23,0) ; ^TMP("RCDPEU1",$J,"N",NAME,PAYERIEN)="" "RTN","RCDPEU1",24,0) ; ^TMP("RCDPEU1",$J,"T",TIN,PAYERIEN)="" "RTN","RCDPEU1",25,0) ; Where: "RTN","RCDPEU1",26,0) ; PAYERIEN = Internal entry number of the payer from file 344.6 "RTN","RCDPEU1",27,0) ; NAME = Payer name, TIN = Payer TIN "RTN","RCDPEU1",28,0) ; FLAG = Pharmacy or Tricare or Medical flag based on Pharmacy and Tricare flags from file 344.6 "RTN","RCDPEU1",29,0) ; T - has tricare flag, P - has pharmacy flag, M - has neither T or P flag. "RTN","RCDPEU1",30,0) ; "RTN","RCDPEU1",31,0) ; Returns - 1 - Success, -1 - Abort "RTN","RCDPEU1",32,0) ; "RTN","RCDPEU1",33,0) N RCA,RET,RETURN,QUIT "RTN","RCDPEU1",34,0) ; "RTN","RCDPEU1",35,0) D INIT "RTN","RCDPEU1",36,0) S RETURN=1 "RTN","RCDPEU1",37,0) ; "RTN","RCDPEU1",38,0) S QUIT=0 "RTN","RCDPEU1",39,0) I PARAM("SELC")="R" D ; "RTN","RCDPEU1",40,0) . S RCA="Select START range for payer names: " "RTN","RCDPEU1",41,0) . F S RET=$$PROMPT(.PARAM,RCA) Q:(RET'=0) D RMESS "RTN","RCDPEU1",42,0) . I RET=-1 S RETURN=-1 Q "RTN","RCDPEU1",43,0) . S RCA="Select END range for payer names: " "RTN","RCDPEU1",44,0) . F S RET=$$PROMPT(.PARAM,RCA) Q:(RET'=0) D RMESS "RTN","RCDPEU1",45,0) . I RET=-1 S RETURN=-1 Q "RTN","RCDPEU1",46,0) . D EXPAND "RTN","RCDPEU1",47,0) ; "RTN","RCDPEU1",48,0) I PARAM("SELC")="S" D ; "RTN","RCDPEU1",49,0) . S QUIT=0 "RTN","RCDPEU1",50,0) . F D Q:QUIT ; "RTN","RCDPEU1",51,0) . . S RET=$$PROMPT(.PARAM,PARAM("DICA")) "RTN","RCDPEU1",52,0) . . I RET=-1 S RETURN=-1,QUIT=1 Q "RTN","RCDPEU1",53,0) . . I RET=0 D ; "RTN","RCDPEU1",54,0) . . . I $D(^TMP("RCDPEU1",$J)) S QUIT=1 "RTN","RCDPEU1",55,0) . . . E D RMESS "RTN","RCDPEU1",56,0) ; "RTN","RCDPEU1",57,0) I RETURN=-1 D CLEAN Q -1 "RTN","RCDPEU1",58,0) S RETURN=$S($D(^TMP("RCDPEU1",$J)):1,1:-1) "RTN","RCDPEU1",59,0) Q RETURN "RTN","RCDPEU1",60,0) ; "RTN","RCDPEU1",61,0) PROMPT(PARAM,RCA) ; Prompt for a payer from file 344.6 with various filter options "RTN","RCDPEU1",62,0) ; Input: PARAM - array of parameters defined in subroutine SELPAY above "RTN","RCDPEU1",63,0) ; Output: ^TMP("RCDPEU1",$J) as defined in subroutine SELPAY above "RTN","RCDPEU1",64,0) ; Returns: 1 - Payer selected "RTN","RCDPEU1",65,0) ; 0 - No payer selected "RTN","RCDPEU1",66,0) ; -1 - user typed '^' or timed out "RTN","RCDPEU1",67,0) ; "RTN","RCDPEU1",68,0) N DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,RETURN,X,Y "RTN","RCDPEU1",69,0) S RETURN=1 "RTN","RCDPEU1",70,0) ; "RTN","RCDPEU1",71,0) I PARAM("SRCH")="N" D ; Select payers by name "RTN","RCDPEU1",72,0) . S DIC=344.6 "RTN","RCDPEU1",73,0) . S DIC(0)="QEA" "RTN","RCDPEU1",74,0) . S DIC("A")=RCA "RTN","RCDPEU1",75,0) . S DIC("S")="I $$CHKPAY^RCDPEU1(Y,"""_PARAM("TYPE")_""","""_PARAM("FILE")_""")" "RTN","RCDPEU1",76,0) . I PARAM("SELC")="R",$D(^TMP("RCDPEU1",$J)) D ; Choosing second name of a range "RTN","RCDPEU1",77,0) . . S DIC("S")=DIC("S")_",$$CHKRNG^RCDPEU1(Y)" ; only offer payer names that follow start range "RTN","RCDPEU1",78,0) . D ^DIC "RTN","RCDPEU1",79,0) . I $D(DTOUT)!$D(DUOUT) S RETURN=-1 Q "RTN","RCDPEU1",80,0) . I Y=-1 S RETURN=0 Q "RTN","RCDPEU1",81,0) . D ADDPAY(+Y) "RTN","RCDPEU1",82,0) ; "RTN","RCDPEU1",83,0) I PARAM("SRCH")="T" D ; Select payers by TIN "RTN","RCDPEU1",84,0) . N RET "RTN","RCDPEU1",85,0) . S DIR("A")="Select Insurance Company TIN" "RTN","RCDPEU1",86,0) . S DIR(0)="FO^1:30" "RTN","RCDPEU1",87,0) . S DIR("?")="Enter the TIN of the payer or '??' to list payers" "RTN","RCDPEU1",88,0) . S DIR("??")="^D TLIST^RCDPEU1" "RTN","RCDPEU1",89,0) . D ^DIR "RTN","RCDPEU1",90,0) . I $D(DTOUT)!$D(DUOUT) S RETURN=-1 Q "RTN","RCDPEU1",91,0) . I Y="" S RETURN=0 Q "RTN","RCDPEU1",92,0) . S RET=$$SRCHTIN(Y,.PARAM) "RTN","RCDPEU1",93,0) . I RET=-1 S RETURN=-1 Q "RTN","RCDPEU1",94,0) . I RET'="" D ADDTIN(RET) "RTN","RCDPEU1",95,0) Q RETURN "RTN","RCDPEU1",96,0) ; "RTN","RCDPEU1",97,0) EXPAND ; Expand range of payer names given start and end points. "RTN","RCDPEU1",98,0) ; Input: Start and end points of the range in the global ^TMP("RCDPEU1",$J) documented in SELPAY above. "RTN","RCDPEU1",99,0) ; Output: More enntries in ^TMP("RCDPEU1",$J), one for each matching payer in the range. "RTN","RCDPEU1",100,0) N K1,NAME "RTN","RCDPEU1",101,0) S NAME(1)=$O(^TMP("RCDPEU1",$J,"N","")) "RTN","RCDPEU1",102,0) S NAME(2)=$O(^TMP("RCDPEU1",$J,"N",""),-1) ; Note if user picks same name as start and end range 1=2 "RTN","RCDPEU1",103,0) ; "RTN","RCDPEU1",104,0) D EXPANDX(NAME(1)) "RTN","RCDPEU1",105,0) ; "RTN","RCDPEU1",106,0) S K1=NAME(1) "RTN","RCDPEU1",107,0) F S K1=$O(^RCY(344.6,"B",K1)) Q:K1=""!(K1]NAME(2)) D EXPANDX(K1) "RTN","RCDPEU1",108,0) Q "RTN","RCDPEU1",109,0) EXPANDX(NAME) ; Add all payers with the same name into the list "RTN","RCDPEU1",110,0) ; Input: NAME - Payer Name "RTN","RCDPEU1",111,0) ; PARAM - Input parameters "RTN","RCDPEU1",112,0) ; Output: ^TMP("RCDPEU1",$J) "RTN","RCDPEU1",113,0) N PAYIEN "RTN","RCDPEU1",114,0) S PAYIEN="" "RTN","RCDPEU1",115,0) F S PAYIEN=$O(^RCY(344.6,"B",NAME,PAYIEN)) Q:PAYIEN="" D ; "RTN","RCDPEU1",116,0) . I $$CHKPAY(PAYIEN,PARAM("TYPE"),PARAM("FILE")) D ADDPAY(PAYIEN) "RTN","RCDPEU1",117,0) Q "RTN","RCDPEU1",118,0) ; "RTN","RCDPEU1",119,0) ADDPAY(PAYIEN) ; Add payer to the output array. "RTN","RCDPEU1",120,0) ; Input - PAYIEN = Internal entry number from file #344.6 "RTN","RCDPEU1",121,0) ; Output - New entries in ^TMP("RCDPEU1",$J "RTN","RCDPEU1",122,0) N NAME,TIN "RTN","RCDPEU1",123,0) S ^TMP("RCDPEU1",$J,PAYIEN)="" "RTN","RCDPEU1",124,0) S NAME=$$GET1^DIQ(344.6,PAYIEN_",",.01,"E") "RTN","RCDPEU1",125,0) S TIN=$$GET1^DIQ(344.6,PAYIEN_",",.02,"E") "RTN","RCDPEU1",126,0) S ^TMP("RCDPEU1",$J,"N",NAME,TIN,PAYIEN)="" "RTN","RCDPEU1",127,0) S ^TMP("RCDPEU1",$J,"T",TIN,NAME,PAYIEN)="" "RTN","RCDPEU1",128,0) Q "RTN","RCDPEU1",129,0) ADDTIN(TIN) ; Add all payers with TIN to the output array "RTN","RCDPEU1",130,0) ; Input - Payer Identifer string (TIN) matching one or more entries in file #344.6 "RTN","RCDPEU1",131,0) N PAYIEN "RTN","RCDPEU1",132,0) S PAYIEN="" "RTN","RCDPEU1",133,0) F S PAYIEN=$O(^RCY(344.6,"C",TIN,PAYIEN)) Q:'PAYIEN D ; "RTN","RCDPEU1",134,0) . D ADDPAY(PAYIEN) "RTN","RCDPEU1",135,0) Q "RTN","RCDPEU1",136,0) SRCHTIN(RCX,PARAM) ; Given user input narrow down the TIN that the user wants "RTN","RCDPEU1",137,0) ; Input: RCX - User input to use in TIN lookup. "RTN","RCDPEU1",138,0) ; PARAM - array of input parameters (see subroutine SELPAY for detailed description) "RTN","RCDPEU1",139,0) N CNT,COUNT,DIR,DTOUT,DUOUT,K1,K2,K3,LIST,QUIT,RETURN,SPACE,SX,X,Y "RTN","RCDPEU1",140,0) I $D(^RCY(344.6,"C",RCX_" ")) D CHKTIN(RCX_" ",.PARAM,.LIST) "RTN","RCDPEU1",141,0) S K1=RCX_" " "RTN","RCDPEU1",142,0) F S K1=$O(^RCY(344.6,"C",K1)) Q:K1=""!($E(K1,1,$L(RCX))'=RCX) D ; "RTN","RCDPEU1",143,0) . D CHKTIN(K1,.PARAM,.LIST) "RTN","RCDPEU1",144,0) ; "RTN","RCDPEU1",145,0) I '$D(LIST) D Q 0 "RTN","RCDPEU1",146,0) . W !,"No matching TIN found",! "RTN","RCDPEU1",147,0) ; "RTN","RCDPEU1",148,0) S COUNT=0,K1="" "RTN","RCDPEU1",149,0) F S K1=$O(LIST("T",K1)) Q:K1="" D ; "RTN","RCDPEU1",150,0) . S COUNT=COUNT+1 "RTN","RCDPEU1",151,0) . S LIST(COUNT)=K1 "RTN","RCDPEU1",152,0) ; Show results and let user pick a TIN by sequence number or TIN "RTN","RCDPEU1",153,0) S (COUNT,K1,K2,K3,RETURN)="",(CNT,QUIT,SX)=0 "RTN","RCDPEU1",154,0) F S COUNT=$O(LIST(COUNT)) Q:'COUNT D I QUIT Q "RTN","RCDPEU1",155,0) . S CNT=CNT+1 "RTN","RCDPEU1",156,0) . W !,$J(COUNT_".",4)_" " S SPACE=0 "RTN","RCDPEU1",157,0) . S K1=LIST(COUNT) "RTN","RCDPEU1",158,0) . F S K2=$O(LIST("T",K1,K2)) Q:K2="" D I QUIT Q "RTN","RCDPEU1",159,0) . . I SPACE W !," " "RTN","RCDPEU1",160,0) . . W $E(K1_$J("",31),1,30) "RTN","RCDPEU1",161,0) . . W $E(K2,1,42) "RTN","RCDPEU1",162,0) . . I 'SPACE S SPACE=1 "RTN","RCDPEU1",163,0) S DIR(0)="NO^1:"_CNT_":0" "RTN","RCDPEU1",164,0) D ^DIR "RTN","RCDPEU1",165,0) I $D(DTOUT)!$D(DUOUT) Q -1 "RTN","RCDPEU1",166,0) I Y S RETURN=LIST(Y) "RTN","RCDPEU1",167,0) Q RETURN "RTN","RCDPEU1",168,0) ; "RTN","RCDPEU1",169,0) CHKPAY(PAYIEN,TYPE,FILE) ; Check if payer meets the filter requirements "RTN","RCDPEU1",170,0) ; Input: PAYIEN - Internal entry number of the payer from file 344.6 "RTN","RCDPEU1",171,0) ; TYPE - M - Medical, P - Pharmacy, T- Tricare, A - All "RTN","RCDPEU1",172,0) ; FILE - 344.4 - ERA, 344.31 EFT - Payer must have entries in the given file "RTN","RCDPEU1",173,0) ; Return: 1 - Payer matches the filter criteria, otherwise 0. "RTN","RCDPEU1",174,0) ; "RTN","RCDPEU1",175,0) N NAME,FLAG,RETURN,TIN "RTN","RCDPEU1",176,0) I TYPE="A",FILE="" Q 1 "RTN","RCDPEU1",177,0) ; "RTN","RCDPEU1",178,0) S RETURN=1 "RTN","RCDPEU1",179,0) I TYPE'="A" D I 'RETURN Q 0 "RTN","RCDPEU1",180,0) . S RETURN=$$CHKTYPE(PAYIEN,TYPE) "RTN","RCDPEU1",181,0) ; "RTN","RCDPEU1",182,0) I FILE D I 'RETURN Q 0 "RTN","RCDPEU1",183,0) . S NAME=$$GET1^DIQ(344.6,PAYIEN_",",.01,"I") "RTN","RCDPEU1",184,0) . S TIN=$$GET1^DIQ(344.6,PAYIEN_",",.02,"I") "RTN","RCDPEU1",185,0) . I '$D(^RCY(FILE,"APT",NAME,TIN)) S RETURN=0 "RTN","RCDPEU1",186,0) Q 1 "RTN","RCDPEU1",187,0) CHKRNG(PAYIEN) ; Check if second picked payer name follows the first "RTN","RCDPEU1",188,0) ; Input: PAYIEN = Internal entry number of payer from file #344.6 "RTN","RCDPEU1",189,0) ; ^TMP("RCDPEU1",$J global array contains previously picked payer "RTN","RCDPEU1",190,0) ; Return: 1 - if PAYIEN's name follows that of payer in ^TMP, otherwise 0 "RTN","RCDPEU1",191,0) ; "RTN","RCDPEU1",192,0) N NAME,RETURN "RTN","RCDPEU1",193,0) S RETURN=0 "RTN","RCDPEU1",194,0) S NAME(1)=$O(^TMP("RCDPEU1",$J,"N","")) "RTN","RCDPEU1",195,0) S NAME(2)=$$GET1^DIQ(344.6,PAYIEN_",",.01,"E") "RTN","RCDPEU1",196,0) I NAME(2)]NAME(1)!(NAME(2)=NAME(1)) S RETURN=1 "RTN","RCDPEU1",197,0) Q RETURN "RTN","RCDPEU1",198,0) ; "RTN","RCDPEU1",199,0) CHKTIN(TIN,PARAM,OUT) ; Given a TIN check filter criteria and add passing entries to the OUT array "RTN","RCDPEU1",200,0) ; Input: TIN = Payer Identifier string that matches one or more payers in file #344.6 "RTN","RCDPEU1",201,0) ; PARAM = Input parameter array. See subroutine SELPAY for detailed documentation "RTN","RCDPEU1",202,0) ; Output: OUT (passed by reference) array of payers matching filter parameters. Sorted by TIN then NAME "RTN","RCDPEU1",203,0) N PAYIEN "RTN","RCDPEU1",204,0) S PAYIEN="" "RTN","RCDPEU1",205,0) F S PAYIEN=$O(^RCY(344.6,"C",TIN,PAYIEN)) Q:PAYIEN="" D ; "RTN","RCDPEU1",206,0) . I $$CHKPAY(PAYIEN,PARAM("TYPE"),PARAM("FILE")) D ; "RTN","RCDPEU1",207,0) . . N PNAME "RTN","RCDPEU1",208,0) . . S PNAME=$$GET1^DIQ(344.6,PAYIEN_",",.01,"E") "RTN","RCDPEU1",209,0) . . I PNAME="" Q "RTN","RCDPEU1",210,0) . . S OUT("T",TIN,PNAME,PAYIEN)="" "RTN","RCDPEU1",211,0) Q "RTN","RCDPEU1",212,0) TLIST ; List TINS for user help. Only TINS matching filter criteria are displayed. "RTN","RCDPEU1",213,0) N COUNT,PAYIEN,QUIT,TIN "RTN","RCDPEU1",214,0) S (QUIT,COUNT)=0 "RTN","RCDPEU1",215,0) S TIN="" "RTN","RCDPEU1",216,0) F S TIN=$O(^RCY(344.6,"C",TIN)) Q:TIN="" D I QUIT Q "RTN","RCDPEU1",217,0) . S PAYIEN="" "RTN","RCDPEU1",218,0) . F S PAYIEN=$O(^RCY(344.6,"C",TIN,PAYIEN)) Q:PAYIEN="" D I QUIT Q "RTN","RCDPEU1",219,0) . . I '$$CHKPAY(PAYIEN,$G(PARAM("TYPE"),"A"),$G(PARAM("FILE"))) Q "RTN","RCDPEU1",220,0) . . S COUNT=COUNT+1 "RTN","RCDPEU1",221,0) . . I COUNT>21 S COUNT=1 I '$$GOON^VALM1() S QUIT=1 Q "RTN","RCDPEU1",222,0) . . W !,$E(TIN_$J("",30),1,30)_" "_$E($$GET1^DIQ(344.6,PAYIEN_",",.01,"E"),1,39) "RTN","RCDPEU1",223,0) Q "RTN","RCDPEU1",224,0) INIT ; Initialize parameters and return array "RTN","RCDPEU1",225,0) ; Input - PARAM array see comments for SELPAY above "RTN","RCDPEU1",226,0) ; "RTN","RCDPEU1",227,0) S PARAM("TYPE")=$G(PARAM("TYPE"),"A") "RTN","RCDPEU1",228,0) S PARAM("FILE")=$G(PARAM("FILE")) "RTN","RCDPEU1",229,0) S PARAM("SRCH")=$G(PARAM("SRCH"),"N") "RTN","RCDPEU1",230,0) S PARAM("SELC")=$G(PARAM("SELC"),"S") "RTN","RCDPEU1",231,0) S PARAM("DICA")=$G(PARAM("DICA"),"Select payer "_$S(PARAM("SRCH")="N":"name",1:"TIN")_": ") "RTN","RCDPEU1",232,0) ; "RTN","RCDPEU1",233,0) K ^TMP("RCDPEU1",$J) "RTN","RCDPEU1",234,0) Q "RTN","RCDPEU1",235,0) CLEAN ; Clean up output array if user aborts "RTN","RCDPEU1",236,0) K ^TMP("RCDPEU1",$J) "RTN","RCDPEU1",237,0) Q "RTN","RCDPEU1",238,0) RTYPE(DEF) ;EP "RTN","RCDPEU1",239,0) ; Input: DEF - Value to use a default "RTN","RCDPEU1",240,0) ; Returns: -1 - User ^ or timed out "RTN","RCDPEU1",241,0) ; A - User selected ALL "RTN","RCDPEU1",242,0) ; M - User selected MEDICAL "RTN","RCDPEU1",243,0) ; P - User selected PHARMACY "RTN","RCDPEU1",244,0) ; B - User selected BOTH "RTN","RCDPEU1",245,0) N DA,DIR,DTOUT,DUOUT,X,Y,DIRUT,DIROUT,RCTYPE,RETURN "RTN","RCDPEU1",246,0) S RCTYPE="" "RTN","RCDPEU1",247,0) S DIR("?")="Enter the type of payer to include" "RTN","RCDPEU1",248,0) S DIR(0)="SA^M:MEDICAL;P:PHARMACY;T:TRICARE;A:ALL" "RTN","RCDPEU1",249,0) S DIR("A")="(M)EDICAL, (P)HARMACY, (T)RICARE or (A)LL: " "RTN","RCDPEU1",250,0) S DIR("B")=$S($G(DEF)'="":DEF,1:"ALL") "RTN","RCDPEU1",251,0) D ^DIR "RTN","RCDPEU1",252,0) K DIR "RTN","RCDPEU1",253,0) I $D(DTOUT)!$D(DUOUT) Q -1 "RTN","RCDPEU1",254,0) Q:Y="" "A" "RTN","RCDPEU1",255,0) S RETURN=$E(Y) "RTN","RCDPEU1",256,0) ; If Pharmacy or Tricare chosen, check if payer exist and if not give warning "RTN","RCDPEU1",257,0) I (RETURN="P"&('$D(^RCY(344.6,"ARX",1)))) D WARN("pharmacy") "RTN","RCDPEU1",258,0) I (RETURN="T"&('$D(^RCY(344.6,"ATR",1)))) D WARN("tricare") "RTN","RCDPEU1",259,0) Q RETURN "RTN","RCDPEU1",260,0) ; "RTN","RCDPEU1",261,0) PAYTYPE(NAME,TIN,TYPE) ; EP "RTN","RCDPEU1",262,0) ; Is a payer Medical, Pharmacy or Tricare based on flags in the payer exclusion file. "RTN","RCDPEU1",263,0) ; Inputs: NAME - The free text name of the payer "RTN","RCDPEU1",264,0) ; TIN - The ID if the payer "RTN","RCDPEU1",265,0) ; TYPE - M : Medical, P : Pharmacy, T: Tricare "RTN","RCDPEU1",266,0) ; Returns : 1 - Yes, payer matches type, 0 - No, payer does not match type "RTN","RCDPEU1",267,0) N IEN,FLAG "RTN","RCDPEU1",268,0) S IEN=$$GETPAY(NAME,TIN) "RTN","RCDPEU1",269,0) I 'IEN Q 0 "RTN","RCDPEU1",270,0) Q $$CHKTYPE(IEN,TYPE) "RTN","RCDPEU1",271,0) ; "RTN","RCDPEU1",272,0) GETPAY(NAME,TIN) ; EP - Get payer IEN given name and TIN "RTN","RCDPEU1",273,0) ; Inputs: NAME - The free text name of the payer "RTN","RCDPEU1",274,0) ; TIN - The ID if the payer "RTN","RCDPEU1",275,0) ; Returns: Internal entry number from file 344.6 "RTN","RCDPEU1",276,0) I NAME=""!(TIN)="" Q 0 "RTN","RCDPEU1",277,0) Q +$O(^RCY(344.6,"CPID",NAME,TIN,"")) "RTN","RCDPEU1",278,0) ; "RTN","RCDPEU1",279,0) CHKTYPE(IEN,TYPE) ; EP "RTN","RCDPEU1",280,0) ; Inputs: IEN - Internal entry number from file 344.6 "RTN","RCDPEU1",281,0) ; TYPE - M : Medical, P : Pharmacy, T: Tricare, A: All "RTN","RCDPEU1",282,0) ; Returns: 1 if the payer matches the type, otherwise 0 "RTN","RCDPEU1",283,0) I TYPE="A" Q 1 "RTN","RCDPEU1",284,0) S FLAG("P")=+$$GET1^DIQ(344.6,IEN_",",.09,"I") "RTN","RCDPEU1",285,0) S FLAG("T")=+$$GET1^DIQ(344.6,IEN_",",.1,"I") "RTN","RCDPEU1",286,0) ; "RTN","RCDPEU1",287,0) I TYPE="T",FLAG("T") Q 1 "RTN","RCDPEU1",288,0) I TYPE="P",FLAG("P") Q 1 "RTN","RCDPEU1",289,0) I TYPE="M",'FLAG("P"),'FLAG("T") Q 1 "RTN","RCDPEU1",290,0) Q 0 "RTN","RCDPEU1",291,0) ISTYPE(FILE,IEN,TYPE) ; EP "RTN","RCDPEU1",292,0) ; Check if payer is a given type based on IEN from a FILE "RTN","RCDPEU1",293,0) ; Input: FILE - file from which to get Payer name and TIN "RTN","RCDPEU1",294,0) ; allowed values 344.4 - ERA, 344.31 - EFT, 361.1 - EOB "RTN","RCDPEU1",295,0) ; IEN - Internal entry number of entry in FILE "RTN","RCDPEU1",296,0) ; TYPE - M : Medical, P : Pharmacy, T: Tricare "RTN","RCDPEU1",297,0) ; Return 1 - payer matches type, else 0. "RTN","RCDPEU1",298,0) I TYPE="A" Q 1 "RTN","RCDPEU1",299,0) N IEN3444,NAME,TIN "RTN","RCDPEU1",300,0) ; For EOB try to get Payer from associated ERA, if none exists use TIN only to check the type. "RTN","RCDPEU1",301,0) I FILE=361.1 D I FILE=361.1 Q $$EOBTYP(IEN,TYPE) ; "RTN","RCDPEU1",302,0) . S IEN3444=$$EOBERA(IEN) "RTN","RCDPEU1",303,0) . I IEN3444 S FILE=344.4,IEN=IEN3444 "RTN","RCDPEU1",304,0) ; "RTN","RCDPEU1",305,0) S NAME=$$GETNAME(FILE,IEN) "RTN","RCDPEU1",306,0) S TIN=$$GETTIN(FILE,IEN) "RTN","RCDPEU1",307,0) I NAME=""!(TIN="") Q 0 "RTN","RCDPEU1",308,0) Q $$PAYTYPE(NAME,TIN,TYPE) "RTN","RCDPEU1",309,0) ; "RTN","RCDPEU1",310,0) ISSEL(FILE,IEN,RCJOB) ; EP "RTN","RCDPEU1",311,0) ; Check if payer was selected by the user give the file and IEN "RTN","RCDPEU1",312,0) ; Input: FILE - file from which to get Payer name and TIN "RTN","RCDPEU1",313,0) ; allowed values 344.4 - ERA, 344.31 - EFT, 361.1 - EOB "RTN","RCDPEU1",314,0) ; IEN - Internal entry number of entry in FILE "RTN","RCDPEU1",315,0) ; Return 1 - payer was selected, else 0. "RTN","RCDPEU1",316,0) ; "RTN","RCDPEU1",317,0) N IEN3444,NAME,RETURN,TIN "RTN","RCDPEU1",318,0) S RETURN=0 "RTN","RCDPEU1",319,0) S RCJOB=$G(RCJOB,$J) "RTN","RCDPEU1",320,0) I FILE=361.1 D I FILE=361.1 Q RETURN "RTN","RCDPEU1",321,0) . S IEN3444=$$EOBERA(IEN) "RTN","RCDPEU1",322,0) . I IEN3444 D ; "RTN","RCDPEU1",323,0) . . S FILE=344.4,IEN=IEN3444 "RTN","RCDPEU1",324,0) . E D ; "RTN","RCDPEU1",325,0) . . S TIN=$$GET1^DIQ(361.1,IEN_",",.03,"E") "RTN","RCDPEU1",326,0) . . I $D(^TMP("RCDPEU1",RCJOB,"T",TIN)) "RTN","RCDPEU1",327,0) ; "RTN","RCDPEU1",328,0) S NAME=$$GETNAME(FILE,IEN) "RTN","RCDPEU1",329,0) S TIN=$$GETTIN(FILE,IEN) "RTN","RCDPEU1",330,0) I NAME=""!(TIN="") Q 0 "RTN","RCDPEU1",331,0) I $D(^TMP("RCDPEU1",RCJOB,"N",NAME,TIN)) S RETURN=1 "RTN","RCDPEU1",332,0) Q RETURN "RTN","RCDPEU1",333,0) ; "RTN","RCDPEU1",334,0) GETNAME(FILE,IEN) ; Get Payer Name give file and IEN "RTN","RCDPEU1",335,0) N FIELD "RTN","RCDPEU1",336,0) S FIELD=$S(FILE=344.4:.06,1:.02) "RTN","RCDPEU1",337,0) Q $$GET1^DIQ(FILE,IEN_",",FIELD,"E") "RTN","RCDPEU1",338,0) ; "RTN","RCDPEU1",339,0) GETTIN(FILE,IEN) ; Get Payer TIN give file and IEN "RTN","RCDPEU1",340,0) N FIELD "RTN","RCDPEU1",341,0) S FIELD=.03 "RTN","RCDPEU1",342,0) Q $$GET1^DIQ(FILE,IEN_",",FIELD,"E") "RTN","RCDPEU1",343,0) ; "RTN","RCDPEU1",344,0) PAYRNG(MIXED,BLANKLN,NMORTIN,PROMPT) ; How does the user want to select payers? "RTN","RCDPEU1",345,0) ; Input: MIXED - 1 to display prompts in mixed case "RTN","RCDPEU1",346,0) ; Optional, defaults to 0 "RTN","RCDPEU1",347,0) ; BLANKLN - 0 skip initial blank line "RTN","RCDPEU1",348,0) ; Optional, defaults to 1 "RTN","RCDPEU1",349,0) ; NMORTIN - 1 to look-up Payer by Payer Name, 2 to look-up by TIN "RTN","RCDPEU1",350,0) ; 0 or undefined - pre-326 behavior, look-up by payer name and don't include TIN in output array. "RTN","RCDPEU1",351,0) ; Optional, defaults to 0 "RTN","RCDPEU1",352,0) ; PROMPT - Alternative prompt "RTN","RCDPEU1",353,0) ; "RTN","RCDPEU1",354,0) ; Output: ^TMP("RCSELPAY",$J) - Array of selected Payers "RTN","RCDPEU1",355,0) ; Returns: A - All, S - Selected, R - Range, (-1) - User '^' or timeout "RTN","RCDPEU1",356,0) ; "RTN","RCDPEU1",357,0) N DIR,DIROUT,DIRUT,DTOUT,DUOUT,RTNFLG,TIN,X,XX,Y "RTN","RCDPEU1",358,0) S:'$D(MIXED) MIXED=0 "RTN","RCDPEU1",359,0) S:'$D(BLANKLN) BLANKLN=1 "RTN","RCDPEU1",360,0) S:'$D(NMORTIN) NMORTIN=0 "RTN","RCDPEU1",361,0) I '$D(PROMPT) S PROMPT=$S(MIXED:"Run Report for",1:"RUN REPORT FOR") ; PRCA*4.5*332 "RTN","RCDPEU1",362,0) ; "RTN","RCDPEU1",363,0) S RTNFLG=0 "RTN","RCDPEU1",364,0) ; "RTN","RCDPEU1",365,0) ; Select option required (All, Selected or Range) "RTN","RCDPEU1",366,0) I NMORTIN=2 D "RTN","RCDPEU1",367,0) . S DIR(0)="SA^A:ALL;S:SPECIFIC" "RTN","RCDPEU1",368,0) . S:MIXED DIR("A")=PROMPT_" (A)LL or (S)PECIFIC Insurance Companies?: " ; PRCA*4.5*332 "RTN","RCDPEU1",369,0) . S:'MIXED DIR("A")=PROMPT_" (A)LL OR (S)PECIFIC INSURANCE COMPANIES?: " ; PRCA*4.5*332 "RTN","RCDPEU1",370,0) E D "RTN","RCDPEU1",371,0) . S DIR(0)="SA^A:ALL;S:SPECIFIC;R:RANGE" "RTN","RCDPEU1",372,0) . S:MIXED DIR("A")=PROMPT_" (A)LL, (S)PECIFIC, or (R)ANGE of Insurance Companies?: " ; PRCA*4.5*332 "RTN","RCDPEU1",373,0) . S:'MIXED DIR("A")=PROMPT_" (A)LL, (S)PECIFIC, OR (R)ANGE OF INSURANCE COMPANIES?: " ; PRCA*4.5*332 "RTN","RCDPEU1",374,0) . S DIR("?",2)="Enter 'RANGE' to select an Insurance Company range." "RTN","RCDPEU1",375,0) S DIR("B")="ALL" "RTN","RCDPEU1",376,0) S DIR("?",1)="Enter 'ALL' to select all Insurance Companies." "RTN","RCDPEU1",377,0) S DIR("?")="Enter 'SPECIFIC' to select specific Insurance Companies." "RTN","RCDPEU1",378,0) W:BLANKLN ! ; PRCA*4.5*318 - Added condition for BLANKLN "RTN","RCDPEU1",379,0) D ^DIR K DIR "RTN","RCDPEU1",380,0) ; "RTN","RCDPEU1",381,0) ; Abort on ^ exit or timeout "RTN","RCDPEU1",382,0) I $D(DTOUT)!$D(DUOUT) S RTNFLG=-1 Q RTNFLG "RTN","RCDPEU1",383,0) ; "RTN","RCDPEU1",384,0) Q Y "RTN","RCDPEU1",385,0) EOBERA(IEN3611) ; Get ERA that corresponds to an EOB so we can find payers. "RTN","RCDPEU1",386,0) ; Input IEN3611 - Internal entry from file 361.1 EOB "RTN","RCDPEU1",387,0) ; Returns - Internal entry number from file 344.4 ERA "RTN","RCDPEU1",388,0) ; use reverse $Order to get the latest ERA in case there is more than one. "RTN","RCDPEU1",389,0) Q $O(^RCY(344.4,"ADET",+IEN3611,"A"),-1) "RTN","RCDPEU1",390,0) ; "RTN","RCDPEU1",391,0) EOBTYP(IEN3611,TYPE) ; If EOB has no ERA, use TIN from EOB to determine M/P/T type "RTN","RCDPEU1",392,0) ; Input IEN3611 - Internal entry from file 361.1 EOB "RTN","RCDPEU1",393,0) ; TYPE - M : Medical, P : Pharmacy, T: Tricare "RTN","RCDPEU1",394,0) ; Returns - 1 at least one payer with TIN is of type TYPE "RTN","RCDPEU1",395,0) N IEN,TIN "RTN","RCDPEU1",396,0) S RETURN=0 "RTN","RCDPEU1",397,0) S TIN=$$GET1^DIQ(361.1,IEN3611_",",.03,"E") "RTN","RCDPEU1",398,0) I TIN'="" D ; "RTN","RCDPEU1",399,0) . S IEN="" "RTN","RCDPEU1",400,0) . F S IEN=$O(^RCY(344.6,"C",TIN_" ",IEN)) Q:'IEN D Q:RETURN=1 "RTN","RCDPEU1",401,0) . . S RETURN=$$CHKTYPE(IEN,TYPE) "RTN","RCDPEU1",402,0) Q RETURN "RTN","RCDPEU1",403,0) ; "RTN","RCDPEU1",404,0) RMESS ; Output message that entry is required. "RTN","RCDPEU1",405,0) W !!,"You must select " "RTN","RCDPEU1",406,0) W $S(PARAM("SELC")="R":"a",1:"at least one")_" " "RTN","RCDPEU1",407,0) W $S(PARAM("SRCH")="N":"payer",1:"TIN"),*7,! "RTN","RCDPEU1",408,0) Q "RTN","RCDPEU1",409,0) ; "RTN","RCDPEU1",410,0) WARN(TYPE) ; Warn user that no payers of TYPE have been flagged "RTN","RCDPEU1",411,0) ; Input: TYPE - P=Pharmacy, T="Tricare" "RTN","RCDPEU1",412,0) ; Output: warning message to screen. "RTN","RCDPEU1",413,0) W !!,"WARNING - There are no "_TYPE_" payers flagged in the system." "RTN","RCDPEU1",414,0) W !," Please use the Identify Payers option to flag payers.",*7 "RTN","RCDPEU1",415,0) Q "RTN","RCDPEU2") 0^35^B44759277 "RTN","RCDPEU2",1,0) RCDPEU2 ;AITC/CJE - ELECTRONIC PAYER UTILITIES ;05-NOV-02 "RTN","RCDPEU2",2,0) ;;4.5;Accounts Receivable;**326,332**;Mar 20, 1995;Build 40 "RTN","RCDPEU2",3,0) ;;Per VA Directive 6402, this routine should not be modified. "RTN","RCDPEU2",4,0) Q "RTN","RCDPEU2",5,0) EFT344(PROMPT,IEN344) ; Select and EFT and update reciept - EP "RTN","RCDPEU2",6,0) ; Input: PROMPT - Prompt to use when picking an EFT "RTN","RCDPEU2",7,0) ; IEN344 - Internal entry number to file 344 "RTN","RCDPEU2",8,0) ; Output "RTN","RCDPEU2",9,0) N FDA,IEN34431,SCREEN "RTN","RCDPEU2",10,0) S SCREEN="I '$O(^RCY(344,""AEFT"",+Y,0)),$P($G(^RCY(344.31,+Y,0)),U,8)=0" "RTN","RCDPEU2",11,0) S IEN34431=$$ASKEFT(PROMPT,SCREEN) "RTN","RCDPEU2",12,0) I IEN34431>0,IEN344 D ; "RTN","RCDPEU2",13,0) . S FDA(344,IEN344_",",.17)=IEN34431 "RTN","RCDPEU2",14,0) . D FILE^DIE("","FDA") "RTN","RCDPEU2",15,0) . I '$D(^TMP("DIERR",$J)) K DIC("W") "RTN","RCDPEU2",16,0) . W !!,IEN34431,!! "RTN","RCDPEU2",17,0) Q "RTN","RCDPEU2",18,0) ASKEFT(PROMPT,SCREEN) ; Select an EFT for an EDI Lockbox receipt - EP "RTN","RCDPEU2",19,0) ; Inputs: PROMPT - Prompt to use when asking user to enter an EFT. "RTN","RCDPEU2",20,0) ; SCREEN - Screen for use in file 344.31 look-up "RTN","RCDPEU2",21,0) ; Returns: IEN from file 344.31 or -1 if user times out or '^' "RTN","RCDPEU2",22,0) ; "RTN","RCDPEU2",23,0) N COUNT,DA,DIC,DIR,DIRUT,DIROUT,DTOUT,DUOUT,FIELDS,FILE,FLAGS,IENS,INDEXES,QUIT,RETURN,VALUE,X,Y "RTN","RCDPEU2",24,0) K ^TMP("DILIST",$J),^TMP("DIERR",$J) "RTN","RCDPEU2",25,0) S (RETURN,QUIT)=0 "RTN","RCDPEU2",26,0) S FILE=344.31,IENS="" "RTN","RCDPEU2",27,0) S FIELDS=".01;.02;.03;.04;.07;.14" "RTN","RCDPEU2",28,0) S FLAGS="M" "RTN","RCDPEU2",29,0) S INDEXES="" "RTN","RCDPEU2",30,0) F D Q:QUIT ; "RTN","RCDPEU2",31,0) . W !,PROMPT R VALUE:DT "RTN","RCDPEU2",32,0) . I '$T S QUIT=1,RETURN=-1 Q ; Timeout "RTN","RCDPEU2",33,0) . I VALUE="" S QUIT=1,RETURN=0 Q "RTN","RCDPEU2",34,0) . I $E(VALUE)="^"!(VALUE="") S QUIT=1,RETURN=-1 Q "RTN","RCDPEU2",35,0) . I $E(VALUE)="?" S VALUE="" "RTN","RCDPEU2",36,0) . I VALUE="" D ; "RTN","RCDPEU2",37,0) . . D LIST^DIC(FILE,"",FIELDS,FLAGS,"*","","","B",SCREEN,"","","") "RTN","RCDPEU2",38,0) . E D ; "RTN","RCDPEU2",39,0) . . D FIND^DIC(FILE,"",FIELDS,FLAGS,VALUE,"","",SCREEN,"","","") "RTN","RCDPEU2",40,0) . S COUNT=$P($G(^TMP("DILIST",$J,0)),"^",1) "RTN","RCDPEU2",41,0) . I COUNT=1,VALUE'="" D Q ; "RTN","RCDPEU2",42,0) . . S RETURN=+$P($G(^TMP("DILIST",$J,2,1)),"^",1),QUIT=1 "RTN","RCDPEU2",43,0) . I COUNT>0 D ; "RTN","RCDPEU2",44,0) . . S RETURN=$$PICKEFT() "RTN","RCDPEU2",45,0) . . I RETURN>0 S QUIT=1 "RTN","RCDPEU2",46,0) Q RETURN "RTN","RCDPEU2",47,0) ; "RTN","RCDPEU2",48,0) PICKEFT() ; Given output from FIND^DIC, pick an EFT from the list "RTN","RCDPEU2",49,0) ; Input: ^TMP("DILIST",$J) in non-packed format "RTN","RCDPEU2",50,0) ; Returns: IEN from file 344.31, or 0 if user does not pick an item from the list "RTN","RCDPEU2",51,0) ; "RTN","RCDPEU2",52,0) N CNT,COUNT,QUIT,RETURN "RTN","RCDPEU2",53,0) S COUNT=$P($G(^TMP("DILIST",$J,0)),"^",1) "RTN","RCDPEU2",54,0) S (RETURN,QUIT)=0 "RTN","RCDPEU2",55,0) F CNT=1:1:COUNT D Q:QUIT ; "RTN","RCDPEU2",56,0) . D WRITE(CNT) "RTN","RCDPEU2",57,0) . I CNT#10=0!(CNT=COUNT) D Q:QUIT ; "RTN","RCDPEU2",58,0) . . S RETURN=$$READ(CNT) I RETURN=-1!(RETURN>0) S QUIT=1 "RTN","RCDPEU2",59,0) Q RETURN "RTN","RCDPEU2",60,0) ; "RTN","RCDPEU2",61,0) READ(LAST) ; "RTN","RCDPEU2",62,0) ; Input: LAST - The last number displayed that can be picked in the number range 1-LAST "RTN","RCDPEU2",63,0) ; Returns: IEN from 344.31 if one is picked, otherwise -1 (^ or timeout) or 0 - nothing picked "RTN","RCDPEU2",64,0) N DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,QUIT,RETURN,VALUE,X,Y "RTN","RCDPEU2",65,0) S RETURN=0 "RTN","RCDPEU2",66,0) S DIR(0)="NO^1:"_LAST "RTN","RCDPEU2",67,0) D ^DIR "RTN","RCDPEU2",68,0) I $D(DTOUT)!($D(DUOUT)) Q -1 "RTN","RCDPEU2",69,0) I Y,$D(^TMP("DILIST",$J,2,Y)) S RETURN=^TMP("DILIST",$J,2,Y) "RTN","RCDPEU2",70,0) Q RETURN "RTN","RCDPEU2",71,0) WRITE(X) ; Write out one entry from 344.31 "RTN","RCDPEU2",72,0) ; Input: X=Counter from ^TMP("DILIST",$J) output from FIND^DIC "RTN","RCDPEU2",73,0) ; Output: To screen "RTN","RCDPEU2",74,0) N DEPDAT,DEPNO,EFTID,EFTIEN,EFTTR,PAYAMT,PAYNAM,PAYTR,SP,TIN "RTN","RCDPEU2",75,0) S SP=$J("",3) "RTN","RCDPEU2",76,0) S EFTIEN=$P(^TMP("DILIST",$J,1,X),".") "RTN","RCDPEU2",77,0) S EFTID=^TMP("DILIST",$J,"ID",X,.01) "RTN","RCDPEU2",78,0) S PAYNAM=^TMP("DILIST",$J,"ID",X,.02) "RTN","RCDPEU2",79,0) S TIN=^TMP("DILIST",$J,"ID",X,.03) "RTN","RCDPEU2",80,0) S PAYTR=^TMP("DILIST",$J,"ID",X,.04) "RTN","RCDPEU2",81,0) S PAYAMT=^TMP("DILIST",$J,"ID",X,.07) "RTN","RCDPEU2",82,0) S DEPNO=$$GET1^DIQ(344.3,EFTIEN,.03,"E") "RTN","RCDPEU2",83,0) S DEPDAT=$$FMTE^XLFDT($$GET1^DIQ(344.3,EFTIEN,.07,"I"),"2DZ") "RTN","RCDPEU2",84,0) ; EFT DETAIL lookup "RTN","RCDPEU2",85,0) S PAYNAM=$E(PAYNAM,1,62-$L(TIN))_"/"_TIN I PAYNAM="/" S PAYNAM="" "RTN","RCDPEU2",86,0) W !,$J(X,4),?7,EFTID,?16," ",PAYNAM "RTN","RCDPEU2",87,0) W !,?16," ",PAYTR,?48," ",$J(PAYAMT,10) "RTN","RCDPEU2",88,0) W ?59," ",DEPNO,?71," ",DEPDAT "RTN","RCDPEU2",89,0) Q "RTN","RCDPEU2",90,0) ; "RTN","RCDPEU2",91,0) ; PRCA*4.5*332 - Start modified code block "RTN","RCDPEU2",92,0) CHKEOB(RCRECTDA,RCTRANDA,RCARRAY) ; EP from RCDPLPL3/4- Link payment to account, move/copy remove EOBs "RTN","RCDPEU2",93,0) ; Inputs RCRECTDA - Receipt IEN file 344 "RTN","RCDPEU2",94,0) ; RCTRANDA - Payment multiple 344.01 IEN under RCRECTDA "RTN","RCDPEU2",95,0) ; RCARRAY - If linking to multiple claims this array contains the list of claims "RTN","RCDPEU2",96,0) ; A1^A2^A3^A4 where A1=Account Linked to, A2=Amount, A3=Comment, A4=Account Name "RTN","RCDPEU2",97,0) ; Outputs None "RTN","RCDPEU2",98,0) N CCLAIM,CLAIM,IEN344491,IEN3611,IFN,JUST,JUST1,LCLAIM,NCLAIM,NCLAIMS,OIFN,ORIG,QUIT "RTN","RCDPEU2",99,0) N RCERA,RCORIG,RCOSEQ,RCSEQ,RCLORIG,RCSORIG,SCLAIM,X "RTN","RCDPEU2",100,0) ; "RTN","RCDPEU2",101,0) S RCERA=$$GET1^DIQ(344,RCRECTDA_",",.18,"I") "RTN","RCDPEU2",102,0) S RCSEQ=$$GET1^DIQ(344.01,RCTRANDA_","_RCRECTDA_",",.27,"I") "RTN","RCDPEU2",103,0) S RCOSEQ=$$GET1^DIQ(344.491,RCSEQ_","_RCERA_",",.01,"E")\1 "RTN","RCDPEU2",104,0) I 'RCOSEQ Q ; No scratch pad entry for this payment, can not proceed. "RTN","RCDPEU2",105,0) S IEN3611=$$ORIG(RCERA,RCOSEQ) "RTN","RCDPEU2",106,0) I 'IEN3611 Q ; Can not identify original EOB, can not proceed "RTN","RCDPEU2",107,0) S ORIG=$$GET1^DIQ(361.1,IEN3611_",",.01,"E") ; Original Claim# "RTN","RCDPEU2",108,0) S OIFN=$$GET1^DIQ(361.1,IEN3611_",",.01,"I") ; Original Bill IEN 399 "RTN","RCDPEU2",109,0) ; "RTN","RCDPEU2",110,0) S (RCSORIG,RCLORIG,RCLSUSP)=0 "RTN","RCDPEU2",111,0) ; Check the scratch pad. Get claims used in initial split/edit. "RTN","RCDPEU2",112,0) ; Store claims other than original in SCLAIM array. "RTN","RCDPEU2",113,0) ; If part payment was left on original claim set RCSORIG=1 "RTN","RCDPEU2",114,0) S X=RCOSEQ "RTN","RCDPEU2",115,0) F S X=$O(^RCY(344.49,RCERA,1,"B",X)) Q:((X\1)'=RCOSEQ) D ; "RTN","RCDPEU2",116,0) . S IEN344491="" "RTN","RCDPEU2",117,0) . F S IEN344491=$O(^RCY(344.49,RCERA,1,"B",X,IEN344491)) Q:'IEN344491 D ; "RTN","RCDPEU2",118,0) . . I +$$GET1^DIQ(344.491,IEN344491_","_RCERA_",",.03)=0 Q ; Ignore lines with zero value "RTN","RCDPEU2",119,0) . . S CLAIM=$$GET1^DIQ(344.491,IEN344491_","_RCERA_",",.02,"E") "RTN","RCDPEU2",120,0) . . I CLAIM=ORIG D ; "RTN","RCDPEU2",121,0) . . . S RCSORIG=1 "RTN","RCDPEU2",122,0) . . E D ; "RTN","RCDPEU2",123,0) . . . S IFN=$$GET1^DIQ(344.491,IEN344491_","_RCERA_",",.07,"I") "RTN","RCDPEU2",124,0) . . . I IFN S SCLAIM(IFN)=IFN "RTN","RCDPEU2",125,0) ; "RTN","RCDPEU2",126,0) ; Check link payment details. Get claims we are linking to now. "RTN","RCDPEU2",127,0) ; Store claims other than original in LCLAIM array. "RTN","RCDPEU2",128,0) ; If part payment was left on original claim set RCLORIG=1 "RTN","RCDPEU2",129,0) S (NCLAIM,NCLAIMS)="" "RTN","RCDPEU2",130,0) I '$D(RCARRAY) D "RTN","RCDPEU2",131,0) . S NCLAIM=$$GET1^DIQ(344.01,RCTRANDA_","_RCRECTDA_",",.03,"E") "RTN","RCDPEU2",132,0) . I NCLAIM["-" S NCLAIM=$P(NCLAIM,"-",2) "RTN","RCDPEU2",133,0) . I NCLAIM=ORIG S RCLORIG=1 Q "RTN","RCDPEU2",134,0) . ; Money is going on a new claim. "RTN","RCDPEU2",135,0) . S IFN=$O(^DGCR(399,"B",NCLAIM,"")) "RTN","RCDPEU2",136,0) . I IFN S LCLAIM(IFN)=IFN "RTN","RCDPEU2",137,0) E D "RTN","RCDPEU2",138,0) . S X=0 "RTN","RCDPEU2",139,0) . F S X=$O(RCARRAY(X)) Q:'X D "RTN","RCDPEU2",140,0) . . ; Check if some money is going back to the original claim or remains in suspense. "RTN","RCDPEU2",141,0) . . I $P(RCARRAY(X),"^",2)'=0 D ; "RTN","RCDPEU2",142,0) . . . I $P(RCARRAY(X),"^",1)="" S RCLSUSP=1 Q ; Some money going back to suspense "RTN","RCDPEU2",143,0) . . . S CLAIM=$P(RCARRAY(X),"^",4) "RTN","RCDPEU2",144,0) . . . I CLAIM=ORIG S RCLORIG=1 Q ; Money going back to original claim "RTN","RCDPEU2",145,0) . . . I NCLAIMS'="" S NCLAIMS=NCLAIMS_"," "RTN","RCDPEU2",146,0) . . . S NCLAIMS=NCLAIMS_CLAIM "RTN","RCDPEU2",147,0) . . . S IFN=$O(^DGCR(399,"B",CLAIM,"")) "RTN","RCDPEU2",148,0) . . . I IFN S LCLAIM(IFN)=IFN "RTN","RCDPEU2",149,0) ; "RTN","RCDPEU2",150,0) ; Do we need to move the EOB or copy it to new claims "RTN","RCDPEU2",151,0) ; We will move the EOB, if the whole payment was put in suspense then linked to a single new claim "RTN","RCDPEU2",152,0) I '$D(SCLAIM),'$D(RCARRAY),'RCLORIG,'RCSORIG D Q ; "RTN","RCDPEU2",153,0) . K CLAIM "RTN","RCDPEU2",154,0) . S IFN=$O(^DGCR(399,"B",NCLAIM,"")) "RTN","RCDPEU2",155,0) . I IFN D ; "RTN","RCDPEU2",156,0) . . S CLAIM(1)=IFN "RTN","RCDPEU2",157,0) . . ; Change claim number on original EOB attached to ERA "RTN","RCDPEU2",158,0) . . D AUTOMOVE^RCDPEM5(IEN3611,.CLAIM,"L") "RTN","RCDPEU2",159,0) ; "RTN","RCDPEU2",160,0) ; We will copy the EOB if money put into suspense is linked to multiple claims. "RTN","RCDPEU2",161,0) ; *Or* if some money went to other claims in the original split. "RTN","RCDPEU2",162,0) I $D(SCLAIM)!(RCSORIG)!($D(RCARRAY)) D ; "RTN","RCDPEU2",163,0) . K CLAIM "RTN","RCDPEU2",164,0) . I '$D(RCARRAY),'RCLORIG D ; "RTN","RCDPEU2",165,0) . . S IFN=$O(^DGCR(399,"B",NCLAIM,"")) "RTN","RCDPEU2",166,0) . . I '$D(SCLAIM(IFN)) S CLAIM(IFN)=IFN ; Link to single claim not in the original split "RTN","RCDPEU2",167,0) . I $D(RCARRAY) D ; "RTN","RCDPEU2",168,0) . . S X="" F S X=$O(LCLAIM(X)) Q:'X D ; "RTN","RCDPEU2",169,0) . . . I '$D(SCLAIM(X)) S CLAIM(X)=X ; Link to a claim that was not included in original split "RTN","RCDPEU2",170,0) . I $D(CLAIM) D ; Copy EOB to CLAIM(s) "RTN","RCDPEU2",171,0) . . ; Copy EOB to new EOBs for "to" claims "RTN","RCDPEU2",172,0) . . D AUTOCOPY^RCDPEM5(IEN3611,.CLAIM,"L") "RTN","RCDPEU2",173,0) ; "RTN","RCDPEU2",174,0) ; Remove the original EOB if no money left in suspense, or split or linked to original claim "RTN","RCDPEU2",175,0) I 'RCSORIG,'RCLORIG,'RCLSUSP D ; "RTN","RCDPEU2",176,0) . S JUST="EEOB removed when payment from suspense was linked to claim(s) "_NCLAIMS "RTN","RCDPEU2",177,0) . D AUTOREM^RCDPEM5(IEN3611,JUST) "RTN","RCDPEU2",178,0) ; "RTN","RCDPEU2",179,0) Q "RTN","RCDPEU2",180,0) ; "RTN","RCDPEU2",181,0) ORIG(RCERA,RCOSEQ) ; Get the original claim from the EOB worklist "RTN","RCDPEU2",182,0) ; Inputs RCERA - ERA IEN from file 344.49 "RTN","RCDPEU2",183,0) ; RCOSEQ - Sequence number IEN from multiple 344.491 "RTN","RCDPEU2",184,0) ; Returns IEN from 361.1. EOB from 344.41 "RTN","RCDPEU2",185,0) N EEOBS,IEN491 "RTN","RCDPEU2",186,0) S IEN491=$O(^RCY(344.49,RCERA,1,"ASEQ",RCOSEQ,0)) "RTN","RCDPEU2",187,0) I IEN491="" Q "" ; Can't find referenced sequence number. "RTN","RCDPEU2",188,0) S EEOBS=$$GET1^DIQ(344.491,IEN491_","_RCERA_",",.09,"E") "RTN","RCDPEU2",189,0) I EEOBS["ADJ"!(EEOBS[",") Q "" ; Don't proceed if this is not a split line. "RTN","RCDPEU2",190,0) Q $$GET1^DIQ(344.41,(+EEOBS)_","_RCERA_",",.02,"I") "RTN","RCDPEU2",191,0) ; PRCA*4.5*332 - End modified code block "RTN","RCDPEUPO") 0^22^B47349551 "RTN","RCDPEUPO",1,0) RCDPEUPO ;ALBANY/KML - Unposted EFT Override ;3 Oct 2018 10:46:35 "RTN","RCDPEUPO",2,0) ;;4.5;Accounts Receivable;**298,332**;Mar 20, 1995;Build 40 "RTN","RCDPEUPO",3,0) ;Per VA Directive 6402, this routine should not be modified. "RTN","RCDPEUPO",4,0) Q "RTN","RCDPEUPO",5,0) ; "RTN","RCDPEUPO",6,0) ; prca*4.5*298 - procedures built to implement the Unposted EFT Override option "RTN","RCDPEUPO",7,0) ; "RTN","RCDPEUPO",8,0) EN ; Display warning message when aged, unposted EFTs exist "RTN","RCDPEUPO",9,0) N MSG "RTN","RCDPEUPO",10,0) D OWNSKEY^XUSRB(.MSG,"RCDPE AGED PMT",DUZ) "RTN","RCDPEUPO",11,0) I 'MSG(0) D NOENTRY Q "RTN","RCDPEUPO",12,0) N AGEDEFTS "RTN","RCDPEUPO",13,0) S AGEDEFTS=$$GETEFTS^RCDPEWLP("A",1) ; need to examine both medical and pharmacy EFTs "RTN","RCDPEUPO",14,0) D DMSGS(AGEDEFTS) "RTN","RCDPEUPO",15,0) Q "RTN","RCDPEUPO",16,0) ; "RTN","RCDPEUPO",17,0) DMSGS(CODES) ; display warning/error messages (if any) "RTN","RCDPEUPO",18,0) ; Input: CODES "RTN","RCDPEUPO",19,0) ; 1P - error condition for aged, unposted Pharmacy EFTs "RTN","RCDPEUPO",20,0) ; 2P - warning condition for aged,unposted Pharmacy EFTs "RTN","RCDPEUPO",21,0) ; 3P - Override exists for aged, unposted pharmacy EFTs "RTN","RCDPEUPO",22,0) ; 1M - error condition for aged, unposted Medical EFTs "RTN","RCDPEUPO",23,0) ; 2M - warning condition for aged, unposted Medical EFTs "RTN","RCDPEUPO",24,0) ; 3M - Override exists for aged, unposted Medical EFTs "RTN","RCDPEUPO",25,0) ; 1T - error condition for aged, unposted Tricare EFTs "RTN","RCDPEUPO",26,0) ; 2T - warning condition for aged, unposted Tricare EFTs "RTN","RCDPEUPO",27,0) ; 3T - Override exists for aged, unposted Tricare EFTs "RTN","RCDPEUPO",28,0) ; 0 - no error or warning conditions "RTN","RCDPEUPO",29,0) ; possible values: "RTN","RCDPEUPO",30,0) ; "1P" or "2P" or "3P" or "1M" or "2M" or "3M" or "1P^1M" or "1P^2M" or "RTN","RCDPEUPO",31,0) ; "1P^3M" or "2P^1M" or "2P^2M" or "2P^3M" or "3P^1M" or "3P^2M" or "3P^3M" "RTN","RCDPEUPO",32,0) I 'CODES D NONE Q "RTN","RCDPEUPO",33,0) N DAYSLIMT,DIR,ERROR,I,LN,MSGTXT,OVERRIDE,S1,S2,STATE,TYPE,X,Y "RTN","RCDPEUPO",34,0) S (OVERRIDE,ERROR)=0 "RTN","RCDPEUPO",35,0) S DIR("A",1)="Current Warning and/or Error messages for Unposted EFTs:" "RTN","RCDPEUPO",36,0) S DIR("A",2)=" ",LN=2 "RTN","RCDPEUPO",37,0) F I=1:1 S STATE=$P(CODES,U,I) Q:STATE="" D "RTN","RCDPEUPO",38,0) . S S1=$E(STATE,1),S2=$E(STATE,2) "RTN","RCDPEUPO",39,0) . I S1=1 D ; 1 = ERROR "RTN","RCDPEUPO",40,0) .. S ERROR=1,TYPE=$G(TYPE)_S2 "RTN","RCDPEUPO",41,0) .. ; Number of days an EFT can age before post prevention rules apply "RTN","RCDPEUPO",42,0) .. S DAYSLIMT=$$GET1^DIQ(344.61,1,$S(S2="M":.06,S2="P":.07,1:.13)) "RTN","RCDPEUPO",43,0) .. S LN=LN+1 "RTN","RCDPEUPO",44,0) .. S DIR("A",LN)="ERROR: Unposted "_$S(S2="P":"pharmacy ",S2="M":"medical ",1:"TRICARE ") "RTN","RCDPEUPO",45,0) .. S DIR("A",LN)=DIR("A",LN)_"EFTs exist that are more than "_DAYSLIMT_" days old." "RTN","RCDPEUPO",46,0) .. S LN=LN+1,DIR("A",LN)="Scratchpad creation is not allowed for newer payments." "RTN","RCDPEUPO",47,0) .. S LN=LN+1,DIR("A",LN)=" " "RTN","RCDPEUPO",48,0) . I S1=2 D ; 2 = warning "RTN","RCDPEUPO",49,0) .. S LN=LN+1 "RTN","RCDPEUPO",50,0) .. S DIR("A",LN)="WARNING: Unposted "_$S(S2="P":"pharmacy ",S2="M":"medical ",1:"TRICARE ") "RTN","RCDPEUPO",51,0) .. S DIR("A",LN)=DIR("A",LN)_"EFTs exist that are more than " "RTN","RCDPEUPO",52,0) .. S DIR("A",LN)=DIR("A",LN)_$S(S2="P":21,1:14)_" days old." "RTN","RCDPEUPO",53,0) .. S LN=LN+1,DIR("A",LN)=" " "RTN","RCDPEUPO",54,0) . I S1=3 D ; OVERRIDE "RTN","RCDPEUPO",55,0) .. S OVERRIDE=OVERRIDE+1 "RTN","RCDPEUPO",56,0) .. S LN=LN+1,DIR("A",LN)="An Override for "_$S(S2="P":"pharmacy ",S2="M":"medical ",1:"TRICARE ") "RTN","RCDPEUPO",57,0) .. S DIR("A",LN)=DIR("A",LN)_"is already in place." "RTN","RCDPEUPO",58,0) .. S LN=LN+1,DIR("A",LN)=" " "RTN","RCDPEUPO",59,0) I OVERRIDE=3 D Q "RTN","RCDPEUPO",60,0) . S DIR(0)="EA",DIR("A")="Press ENTER to continue: " "RTN","RCDPEUPO",61,0) . D ^DIR "RTN","RCDPEUPO",62,0) I ERROR D "RTN","RCDPEUPO",63,0) . M MSGTXT=DIR("A") "RTN","RCDPEUPO",64,0) . S DIR(0)="YA" "RTN","RCDPEUPO",65,0) . S LN=LN+1,DIR("A",LN)="An override will allow unrestricted scratchpad creation for one day." "RTN","RCDPEUPO",66,0) . S DIR("A")="Do you want to continue (Y/N)? " "RTN","RCDPEUPO",67,0) . D ^DIR "RTN","RCDPEUPO",68,0) . Q:'Y "RTN","RCDPEUPO",69,0) . S OVERRIDE=$$OVERRIDE(TYPE,.MSGTXT) "RTN","RCDPEUPO",70,0) . I OVERRIDE D MAIL(.MSGTXT) "RTN","RCDPEUPO",71,0) I 'ERROR D "RTN","RCDPEUPO",72,0) . S LN=LN+1,DIR("A",LN)="There are no error conditions to override." "RTN","RCDPEUPO",73,0) . S LN=LN+1,DIR("A",LN)=" ",DIR("A")="Press ENTER to continue: " "RTN","RCDPEUPO",74,0) . S DIR(0)="EA" D ^DIR "RTN","RCDPEUPO",75,0) Q "RTN","RCDPEUPO",76,0) ; "RTN","RCDPEUPO",77,0) OVERRIDE(TYPE,TEXT) ; when ERROR state exists, perform the Override "RTN","RCDPEUPO",78,0) ; Input: TYPE - "M" Medical "RTN","RCDPEUPO",79,0) ; "P" Phamacy "RTN","RCDPEUPO",80,0) ; "T" - Tricare "RTN","RCDPEUPO",81,0) ; Any combination of above flags "RTN","RCDPEUPO",82,0) ; TEXT - Warning and/or error statements; passed by reference "RTN","RCDPEUPO",83,0) ; Output: TEXT - Additional text to be displayed with warning and/or error statements "RTN","RCDPEUPO",84,0) ; contents of TEXT array will be in the body of the mail message "RTN","RCDPEUPO",85,0) ; (refer to MAIL tag) "RTN","RCDPEUPO",86,0) ; Returns: DONE - 1 - OVERRIDE was performed; 0 - Override was not performed "RTN","RCDPEUPO",87,0) ; "RTN","RCDPEUPO",88,0) N DIR,DIRUT,DONE,DTTM,DUOUT,RCDFDA,REASON,X1,Y "RTN","RCDPEUPO",89,0) L +^RCY(344.61,1,0):DILOCKTM E D NOLOCK S DONE=0 G OVERQ "RTN","RCDPEUPO",90,0) S DONE=1 "RTN","RCDPEUPO",91,0) I TYPE="P"!(TYPE="M")!(TYPE="T") D "RTN","RCDPEUPO",92,0) . S DIR(0)="EA",DIR("A",1)="An Override now exists for posting " "RTN","RCDPEUPO",93,0) . S DIR("A",1)=DIR("A",1)_$S(TYPE="P":"pharmacy ",TYPE="M":"medical ",1:"TRICARE ")_"payments." "RTN","RCDPEUPO",94,0) . S DIR("A",2)=" " "RTN","RCDPEUPO",95,0) . S DIR("A")="Press ENTER to continue: " "RTN","RCDPEUPO",96,0) . D ^DIR "RTN","RCDPEUPO",97,0) I $L(TYPE)>1 D I 'DONE G OVERQ "RTN","RCDPEUPO",98,0) . S DIR(0)="SA^" "RTN","RCDPEUPO",99,0) . S:TYPE["M" DIR(0)=DIR(0)_"M:Medical;" "RTN","RCDPEUPO",100,0) . S:TYPE["P" DIR(0)=DIR(0)_"P:Pharmacy;" "RTN","RCDPEUPO",101,0) . S:TYPE["T" DIR(0)=DIR(0)_"T:TRICARE;" "RTN","RCDPEUPO",102,0) . I $L(TYPE)=3 S DIR("A")="Override for (M)edical, (P)harmacy or (T)RICARE? " "RTN","RCDPEUPO",103,0) . E D "RTN","RCDPEUPO",104,0) . . S DIR("A")="Override for " "RTN","RCDPEUPO",105,0) . . I (TYPE="PM")!(TYPE="MP") S DIR("A")=DIR("A")_"(M)edical or (P)harmacy? " "RTN","RCDPEUPO",106,0) . . E I (TYPE="PT")!(TYPE="TP") S DIR("A")=DIR("A")_"(P)harmacy or (T)RICARE? " "RTN","RCDPEUPO",107,0) . . E S DIR("A")=DIR("A")_"(M)edical or (T)RICARE? " "RTN","RCDPEUPO",108,0) . D ^DIR "RTN","RCDPEUPO",109,0) . I $D(DUOUT)!($D(DIRUT)) S DONE=0 Q "RTN","RCDPEUPO",110,0) . S TYPE=Y "RTN","RCDPEUPO",111,0) W ! "RTN","RCDPEUPO",112,0) K DIR "RTN","RCDPEUPO",113,0) S DIR("A")="Reason for Override: ",DIR(0)="FA^1:50" "RTN","RCDPEUPO",114,0) D ^DIR "RTN","RCDPEUPO",115,0) I $D(DUOUT)!($D(DIRUT)) D G OVERQ "RTN","RCDPEUPO",116,0) . S DONE=0 "RTN","RCDPEUPO",117,0) . W !!," Need to enter a reason for Override.",!," Override not performed.",! "RTN","RCDPEUPO",118,0) S REASON=Y,DTTM=$$NOW^XLFDT "RTN","RCDPEUPO",119,0) S RCDFDA(344.61,"1,",$S(TYPE="M":20,TYPE="P":21,1:26))=DTTM "RTN","RCDPEUPO",120,0) S RCDFDA(344.61,"1,",$S(TYPE="M":22,TYPE="P":23,1:27))=DUZ "RTN","RCDPEUPO",121,0) S RCDFDA(344.61,"1,",$S(TYPE="M":24,TYPE="P":25,1:28))=REASON "RTN","RCDPEUPO",122,0) D FILE^DIE("","RCDFDA") "RTN","RCDPEUPO",123,0) S X1="" S X1=$O(TEXT(X1),-1) "RTN","RCDPEUPO",124,0) S X1=X1+1 "RTN","RCDPEUPO",125,0) S TEXT(X1)=$S(TYPE="M":"Medical ",TYPE="P":"Pharmacy ",1:"TRICARE ")_"Override Details" "RTN","RCDPEUPO",126,0) S X1=X1+1 "RTN","RCDPEUPO",127,0) S TEXT(X1)="User: "_$P($G(^VA(200,DUZ,0)),"^") S X1=X1+1 "RTN","RCDPEUPO",128,0) S TEXT(X1)="Date/Time: "_DTTM "RTN","RCDPEUPO",129,0) S TEXT(X1)="Reason for Override: "_REASON "RTN","RCDPEUPO",130,0) OVERQ ; "RTN","RCDPEUPO",131,0) L -^RCY(344.61,1,0) "RTN","RCDPEUPO",132,0) Q DONE "RTN","RCDPEUPO",133,0) ; "RTN","RCDPEUPO",134,0) MAIL(TEXT) ;generate mail message when OVERRIDE is implemented "RTN","RCDPEUPO",135,0) ; Input: TEXT - Lines of text that represent the body of the mail message "RTN","RCDPEUPO",136,0) ; "RTN","RCDPEUPO",137,0) N ARRAY,CNT,CNT1,GLB,RCPROG1,SBJ,SUB "RTN","RCDPEUPO",138,0) S RCPROG1="RCDUPEO",GLB=$NA(^TMP(RCPROG1,$J,"XMTEXT")) "RTN","RCDPEUPO",139,0) ; "RTN","RCDPEUPO",140,0) ;Build header "RTN","RCDPEUPO",141,0) S SUB="EFT" K @GLB "RTN","RCDPEUPO",142,0) S SBJ="EDI LBOX-STA# "_$P($$SITE^VASITE,"^",3)_"-Unposted EFTs Override "_$$FMTE^XLFDT($$NOW^XLFDT) "RTN","RCDPEUPO",143,0) M @GLB=TEXT "RTN","RCDPEUPO",144,0) N XMDUZ,XMINSTR,XMSUB,XMTEXT,XMY "RTN","RCDPEUPO",145,0) S XMDUZ=DUZ,XMTEXT=GLB,XMSUB=SBJ,XMY("I:G.RCDPE AUDIT")="" "RTN","RCDPEUPO",146,0) S XMINSTR("FROM")="POSTMASTER" "RTN","RCDPEUPO",147,0) S XMINSTR("FLAGS")="P" "RTN","RCDPEUPO",148,0) D SENDMSG^XMXAPI(XMDUZ,XMSUB,XMTEXT,.XMY,.XMINSTR) "RTN","RCDPEUPO",149,0) Q "RTN","RCDPEUPO",150,0) ; "RTN","RCDPEUPO",151,0) CHECK(TYPE,OVERRIDE) ; Determine if override exists for today's date "RTN","RCDPEUPO",152,0) ; Input: TYPE - "M" for medical, "P" for Pharmacy or "T" for Tricare "RTN","RCDPEUPO",153,0) ; OVERRIDE - Passed by reference; array to hold the OVERRIDE data "RTN","RCDPEUPO",154,0) ; Output: OVERRIDE - Returned array holding existing OVERRIDE data "RTN","RCDPEUPO",155,0) K OVERRIDE "RTN","RCDPEUPO",156,0) ; "RTN","RCDPEUPO",157,0) ; Get MEDICAL EFT OVERRIDE (344.61, 20), PHARMACY EFT OVERRIDE (344.61, 21) or "RTN","RCDPEUPO",158,0) ; TRICARE EFT OVERRIDE (344.61, 20) date dependent on type of EFTs "RTN","RCDPEUPO",159,0) S OVERRIDE(TYPE)=+$$GET1^DIQ(344.61,1,$S(TYPE="M":20,TYPE="P":21,1:26),"I") "RTN","RCDPEUPO",160,0) I 'OVERRIDE(TYPE) K OVERRIDE(TYPE) S OVERRIDE=0 Q "RTN","RCDPEUPO",161,0) ; "RTN","RCDPEUPO",162,0) ; Override does not exist for 'TODAYS' date, post prevention rules will apply "RTN","RCDPEUPO",163,0) I $P(OVERRIDE(TYPE),".")'=DT K OVERRIDE(TYPE) S OVERRIDE=0 Q "RTN","RCDPEUPO",164,0) S OVERRIDE=1 "RTN","RCDPEUPO",165,0) Q "RTN","RCDPEUPO",166,0) ; "RTN","RCDPEUPO",167,0) NONE ; the system does not have any aged, unposted EFTs "RTN","RCDPEUPO",168,0) N DIR "RTN","RCDPEUPO",169,0) S DIR(0)="EA" "RTN","RCDPEUPO",170,0) S DIR("A",1)="The sytem does not have any aged, unposted EFTs." "RTN","RCDPEUPO",171,0) S DIR("A",2)="Therefore, no error conditions to override." "RTN","RCDPEUPO",172,0) S DIR("A",3)=" " "RTN","RCDPEUPO",173,0) S DIR("A")="Press ENTER to continue: " "RTN","RCDPEUPO",174,0) D ^DIR "RTN","RCDPEUPO",175,0) Q "RTN","RCDPEUPO",176,0) ; "RTN","RCDPEUPO",177,0) NOACTION ; OVERRIDE already exists "RTN","RCDPEUPO",178,0) ; Input: TYPE - "M" for medical, "P" for Pharmacy or "T" for Tricare "RTN","RCDPEUPO",179,0) N DIR "RTN","RCDPEUPO",180,0) S DIR(0)="EA" "RTN","RCDPEUPO",181,0) S DIR("A",1)="An Override for "_$S(TYPE="P":"pharmacy ",TYPE="M":"medical ",1:"TRICARE ") "RTN","RCDPEUPO",182,0) S DIR("A",1)=DIR("A",1)_"is already in place." "RTN","RCDPEUPO",183,0) S DIR("A",2)="No action needed" "RTN","RCDPEUPO",184,0) S DIR("A",3)=" " "RTN","RCDPEUPO",185,0) S DIR("A")="Press ENTER to continue: " "RTN","RCDPEUPO",186,0) D ^DIR "RTN","RCDPEUPO",187,0) Q "RTN","RCDPEUPO",188,0) ; "RTN","RCDPEUPO",189,0) NOENTRY ; user is not authorized to use the option "RTN","RCDPEUPO",190,0) N DIR "RTN","RCDPEUPO",191,0) S DIR(0)="EA" "RTN","RCDPEUPO",192,0) S DIR("A",1)="You are not authorized to use this option." "RTN","RCDPEUPO",193,0) S DIR("A",2)="This option is locked with RCDPE AGED PMT key." "RTN","RCDPEUPO",194,0) S DIR("A",3)=" " "RTN","RCDPEUPO",195,0) S DIR("A")="Press ENTER to continue: " "RTN","RCDPEUPO",196,0) D ^DIR "RTN","RCDPEUPO",197,0) Q "RTN","RCDPEUPO",198,0) ; "RTN","RCDPEUPO",199,0) NOLOCK ; entry at 344.61 cannot be locked "RTN","RCDPEUPO",200,0) N DIR "RTN","RCDPEUPO",201,0) S DIR(0)="EA" "RTN","RCDPEUPO",202,0) S DIR("A",1)="Another user is editing the Override Parameters." "RTN","RCDPEUPO",203,0) S DIR("A",2)="Try again later." "RTN","RCDPEUPO",204,0) S DIR("A",3)=" " "RTN","RCDPEUPO",205,0) S DIR("A")="Press ENTER to continue: " "RTN","RCDPEUPO",206,0) D ^DIR "RTN","RCDPEUPO",207,0) Q "RTN","RCDPEUPO",208,0) ; "RTN","RCDPEWL0") 0^42^B222344847 "RTN","RCDPEWL0",1,0) RCDPEWL0 ;ALB/TMK/PJH - ELECTRONIC EOB WORKLIST ACTIONS ;Jun 06, 2014@19:11:19 "RTN","RCDPEWL0",2,0) ;;4.5;Accounts Receivable;**173,208,252,269,298,317,321,326,332**;Mar 20, 1995;Build 40 "RTN","RCDPEWL0",3,0) ;Per VA Directive 6402, this routine should not be modified. "RTN","RCDPEWL0",4,0) Q "RTN","RCDPEWL0",5,0) ; "RTN","RCDPEWL0",6,0) PARAMS(SOURCE) ; Retrieve/Edit/Save View Parameters for ERA Worklist "RTN","RCDPEWL0",7,0) ; Input: SOURCE - "MO" - Menu Option "RTN","RCDPEWL0",8,0) ; "CV" - Change View Action "RTN","RCDPEWL0",9,0) ; Output: Sort/Filtering Criteria for the worklist sent into ^TMP("RCERA_PARAMS",$J) "RTN","RCDPEWL0",10,0) ; ^TMP("RCERA_PARAMS",$J,"RCPOST") - ERA Posting Status ("P":Posted/"U":Unposted) "RTN","RCDPEWL0",11,0) ; ^TMP("RCERA_PARAMS",$J,"RCAUTOP")- Auto-Posting Queue "RTN","RCDPEWL0",12,0) ; ("A":Auto-Posting/"N":Non Auto-Posting/"B":Both) "RTN","RCDPEWL0",13,0) ; ^TMP("RCERA_PARAMS",$J,"RCAPSTA")- Auto-Posting Status ; PRCA*4.5*326 "RTN","RCDPEWL0",14,0) ; ("M":Marked/"P":Partial/"C":Complete/"A":All) "RTN","RCDPEWL0",15,0) ; ^TMP("RCERA_PARAMS",$J,"RCMATCH")- ERA Matching Status ("M":Matched/"U":Unmatched) "RTN","RCDPEWL0",16,0) ; ^TMP("RCERA_PARAMS",$J,"RCTYPE") - ERA Claim Type ("M":Medical/"P":Pharmacy/"B":Both) "RTN","RCDPEWL0",17,0) ; ^TMP("RCERA_PARAMS",$J,"RCDT") - A1^A2 Where: "RTN","RCDPEWL0",18,0) ; A1 - ERA Received EARLIEST DATE (Range Limited Only) "RTN","RCDPEWL0",19,0) ; A2 - ERA Received LATEST DATE (Range Limited Only) "RTN","RCDPEWL0",20,0) ; ^TMP("RCERA_PARAMS",$J,"RCPAYR") - B1^B2^B3 Where: "RTN","RCDPEWL0",21,0) ; B1 - All Payers/Range of Payers "RTN","RCDPEWL0",22,0) ; ("A": All/"R":Range of Payers) "RTN","RCDPEWL0",23,0) ; B2 - START WITH PAYER (e.g.,'AET') "RTN","RCDPEWL0",24,0) ; (Range Limited Only) "RTN","RCDPEWL0",25,0) ; B3 - GO TO PAYER (e.g.,'AETZ') (Range Limited Only) "RTN","RCDPEWL0",26,0) ; "RTN","RCDPEWL0",27,0) ; ^TMP("RCERA_PVW",$J) - Same layout as ^TMP("RCERA_PARAMS",$J). This global contains "RTN","RCDPEWL0",28,0) ; the sort/filters of the user's preferred view (for ERA main page) "RTN","RCDPEWL0",29,0) ; while ^TMP("RCERA_PARAMS",$J) contains the sort/filters of what is "RTN","RCDPEWL0",30,0) ; currently displayed. They may or may not be the same values. "RTN","RCDPEWL0",31,0) ; "RTN","RCDPEWL0",32,0) ; ^TMP("RCSCRATCH_PVW",$J) - This global contains the sort/filters of the user's preferred view "RTN","RCDPEWL0",33,0) ; for the Scratch Pad. See PARAMS^RCDPEWLA for the layout. "RTN","RCDPEWL0",34,0) ; "RTN","RCDPEWL0",35,0) ; RCQUIT=1 if the user exited out, 0 otherwise "RTN","RCDPEWL0",36,0) ; "RTN","RCDPEWL0",37,0) N RCXPAR,USEPVW,X,XX,Y ; PRCA*4.5*317 Added USEPVW,XX "RTN","RCDPEWL0",38,0) S RCQUIT=0 "RTN","RCDPEWL0",39,0) ; "RTN","RCDPEWL0",40,0) ; Ask Date Range Selection when coming straight from the menu option "RTN","RCDPEWL0",41,0) I SOURCE="MO" D Q:RCQUIT "RTN","RCDPEWL0",42,0) . K ^TMP("RCERA_PARAMS",$J),^TMP("RCERA_PVW",$J),^TMP("RCSCRATCH_PVW",$J) "RTN","RCDPEWL0",43,0) . S RCQUIT=$$DTR() ; Set date range filter "RTN","RCDPEWL0",44,0) . Q:RCQUIT "RTN","RCDPEWL0",45,0) . ; "RTN","RCDPEWL0",46,0) . ;Retrieve user's saved preferred view (if any) "RTN","RCDPEWL0",47,0) . D GETWLPVW(.RCXPAR) "RTN","RCDPEWL0",48,0) ; "RTN","RCDPEWL0",49,0) ;Only ask user if they want to use their preferred view in the following scenarios: "RTN","RCDPEWL0",50,0) ; a) Source is "MO" and user has a preferred view on file "RTN","RCDPEWL0",51,0) ; b) Source is "CV" (change view action), user has a preferred view but is "RTN","RCDPEWL0",52,0) ; not using the preferred view criteria at this time. "RTN","RCDPEWL0",53,0) S XX=$$PREFVW(SOURCE) "RTN","RCDPEWL0",54,0) I ((XX=1)&(SOURCE="MO"))!((XX=0)&(SOURCE="CV")) D Q:USEPVW "RTN","RCDPEWL0",55,0) . ; "RTN","RCDPEWL0",56,0) . ; Ask the user if they want to use the preferred view "RTN","RCDPEWL0",57,0) . S USEPVW=$$ASKUVW() "RTN","RCDPEWL0",58,0) . I USEPVW=-1 S RCQUIT=1 Q "RTN","RCDPEWL0",59,0) . Q:'USEPVW "RTN","RCDPEWL0",60,0) . ; "RTN","RCDPEWL0",61,0) . ; Set the Sort/Filtering Criteria from the preferred view "RTN","RCDPEWL0",62,0) . M ^TMP("RCERA_PARAMS",$J)=^TMP("RCERA_PVW",$J) "RTN","RCDPEWL0",63,0) ; "RTN","RCDPEWL0",64,0) W !!,"Select parameters for displaying the list of ERAs" "RTN","RCDPEWL0",65,0) S RCQUIT=$$PARAMS2^RCDPEWLD() "RTN","RCDPEWL0",66,0) Q:RCQUIT "RTN","RCDPEWL0",67,0) D SAVEPVW ; Ask if they want to save as preferred view "RTN","RCDPEWL0",68,0) Q "RTN","RCDPEWL0",69,0) ; "RTN","RCDPEWL0",70,0) GETWLPVW(RCXPAR) ; Retrieves the preferred view settings for the ERA worklist "RTN","RCDPEWL0",71,0) ; for the user "RTN","RCDPEWL0",72,0) ; Input: None "RTN","RCDPEWL0",73,0) ; Output: RCXPAR() - Array of preferred view sort/filter criteria "RTN","RCDPEWL0",74,0) ; ^TMP("RCERA_PARAMS",$J)- Global array of preferred view settings "RTN","RCDPEWL0",75,0) ; ^TMP("RCERA_PVW") - A copy of the preferred settings (if any) "RTN","RCDPEWL0",76,0) N XX "RTN","RCDPEWL0",77,0) K RCXPAR "RTN","RCDPEWL0",78,0) D GETLST^XPAR(.RCXPAR,"USR","RCDPE EDI LOCKBOX WORKLIST","I") "RTN","RCDPEWL0",79,0) D:$D(RCXPAR("ERA_POSTING_STATUS")) PVWSAVE(.RCXPAR) "RTN","RCDPEWL0",80,0) ; "RTN","RCDPEWL0",81,0) S XX=$G(RCXPAR("ERA_POSTING_STATUS")) "RTN","RCDPEWL0",82,0) S ^TMP("RCERA_PARAMS",$J,"RCPOST")=$S(XX'="":XX,1:"U") "RTN","RCDPEWL0",83,0) S XX=$G(RCXPAR("ERA_AUTO_POSTING")) "RTN","RCDPEWL0",84,0) S ^TMP("RCERA_PARAMS",$J,"RCAUTOP")=$S(XX'="":XX,1:"B") "RTN","RCDPEWL0",85,0) S XX=$G(RCXPAR("ERA-EFT_MATCH_STATUS")) "RTN","RCDPEWL0",86,0) S ^TMP("RCERA_PARAMS",$J,"RCMATCH")=$S(XX'="":XX,1:"B") "RTN","RCDPEWL0",87,0) S XX=$G(RCXPAR("ERA_CLAIM_TYPE")) "RTN","RCDPEWL0",88,0) ; S ^TMP("RCERA_PARAMS",$J,"RCTYPE")=$S(XX'="":XX,1:"B") ; PRCA*4.5*321 "RTN","RCDPEWL0",89,0) S ^TMP("RCERA_PARAMS",$J,"RCTYPE")=$S(XX'="":XX,1:"A") ; PRCA*4.5*321 change default to (A)LL "RTN","RCDPEWL0",90,0) S XX=$G(RCXPAR("ALL_PAYERS/RANGE_OF_PAYERS")) "RTN","RCDPEWL0",91,0) S ^TMP("RCERA_PARAMS",$J,"RCPAYR")=$S(XX'="":$TR(XX,";","^"),1:"A") "RTN","RCDPEWL0",92,0) S XX=$G(RCXPAR("ERA_PAYMENT_TYPE")) ; PRCA*4.5*321 new filter "RTN","RCDPEWL0",93,0) S ^TMP("RCERA_PARAMS",$J,"RCPAYMNT")=$S(XX'="":XX,1:"B") ; PRCA*4.5*321 "RTN","RCDPEWL0",94,0) S XX=$G(RCXPAR("AUTO-POST_STATUS")) ; PRCA*4.5*326 "RTN","RCDPEWL0",95,0) S ^TMP("RCERA_PARAMS",$J,"RCAPSTA")=$S(XX'="":XX,1:"A") ; PRCA*4.5*326 "RTN","RCDPEWL0",96,0) Q "RTN","RCDPEWL0",97,0) ; "RTN","RCDPEWL0",98,0) PVWSAVE(RCXPAR) ; Save a copy of the preferred view on file "RTN","RCDPEWL0",99,0) ; PRCA*4.5*317 added subroutine "RTN","RCDPEWL0",100,0) ; Input: RCXPAR - array of preferred view setting for the user "RTN","RCDPEWL0",101,0) ; Output: ^TMP("RCERA_PVW") - a copy of the preferred settings "RTN","RCDPEWL0",102,0) ; "RTN","RCDPEWL0",103,0) K ^TMP("RCERA_PVW",$J) "RTN","RCDPEWL0",104,0) ; only continue if we have answers to all ERA Worklist related preferred view prompts "RTN","RCDPEWL0",105,0) Q:'$D(RCXPAR("ERA_POSTING_STATUS")) "RTN","RCDPEWL0",106,0) Q:'$D(RCXPAR("ERA_AUTO_POSTING")) "RTN","RCDPEWL0",107,0) Q:'$D(RCXPAR("ERA-EFT_MATCH_STATUS")) "RTN","RCDPEWL0",108,0) Q:'$D(RCXPAR("ERA_CLAIM_TYPE")) "RTN","RCDPEWL0",109,0) Q:'$D(RCXPAR("ALL_PAYERS/RANGE_OF_PAYERS")) "RTN","RCDPEWL0",110,0) Q:'$D(RCXPAR("ERA_PAYMENT_TYPE")) ; PRCA*4.5*321 "RTN","RCDPEWL0",111,0) Q:'$D(RCXPAR("AUTO-POST_STATUS")) ; PRCA*4.5*326 "RTN","RCDPEWL0",112,0) ; "RTN","RCDPEWL0",113,0) S ^TMP("RCERA_PVW",$J,"RCPOST")=RCXPAR("ERA_POSTING_STATUS") "RTN","RCDPEWL0",114,0) S ^TMP("RCERA_PVW",$J,"RCAUTOP")=RCXPAR("ERA_AUTO_POSTING") "RTN","RCDPEWL0",115,0) S ^TMP("RCERA_PVW",$J,"RCMATCH")=RCXPAR("ERA-EFT_MATCH_STATUS") "RTN","RCDPEWL0",116,0) S ^TMP("RCERA_PVW",$J,"RCTYPE")=RCXPAR("ERA_CLAIM_TYPE") "RTN","RCDPEWL0",117,0) S ^TMP("RCERA_PVW",$J,"RCPAYR")=$TR(RCXPAR("ALL_PAYERS/RANGE_OF_PAYERS"),";","^") "RTN","RCDPEWL0",118,0) S ^TMP("RCERA_PVW",$J,"RCPAYMNT")=RCXPAR("ERA_PAYMENT_TYPE") ; PRCA*4.5*321 new filter "RTN","RCDPEWL0",119,0) S ^TMP("RCERA_PVW",$J,"RCPAPST")=RCXPAR("AUTO-POST_STATUS") ; PRCA*4.5*326 "RTN","RCDPEWL0",120,0) Q "RTN","RCDPEWL0",121,0) ; "RTN","RCDPEWL0",122,0) PREFVW(SOURCE) ; Checks to see if the user has a preferred view "RTN","RCDPEWL0",123,0) ; PRCA*4.5*317 added subroutine "RTN","RCDPEWL0",124,0) ; When source is 'CV', checks to see if the preferred view is being used "RTN","RCDPEWL0",125,0) ; Input: SOURCE - 'MO' - When called from the Worklist menu "RTN","RCDPEWL0",126,0) ; option "RTN","RCDPEWL0",127,0) ; 'CV' - When called from the Change View "RTN","RCDPEWL0",128,0) ; action "RTN","RCDPEWL0",129,0) ; "RTN","RCDPEWL0",130,0) ; ^TMP("RCERA_PVW") - Global array of preferred view settings "RTN","RCDPEWL0",131,0) ; ^TMP("RCERA_PARAMS") - Global array of currently in use defaults "RTN","RCDPEWL0",132,0) ; Returns: 1 - User has preferred view if SOURCE is 'MO' or is using "RTN","RCDPEWL0",133,0) ; their preferred view if SOURCE is 'CV' "RTN","RCDPEWL0",134,0) ; 0 - User is not using their preferred view "RTN","RCDPEWL0",135,0) ; -1 - User does not have a preferred view "RTN","RCDPEWL0",136,0) I SOURCE="MO" Q $S($D(^TMP("RCERA_PVW",$J)):1,1:-1) "RTN","RCDPEWL0",137,0) Q:'$D(^TMP("RCERA_PVW",$J)) -1 ; No stored preferred view "RTN","RCDPEWL0",138,0) Q:$G(^TMP("RCERA_PARAMS",$J,"RCPOST"))'=$G(^TMP("RCERA_PVW",$J,"RCPOST")) 0 "RTN","RCDPEWL0",139,0) Q:$G(^TMP("RCERA_PARAMS",$J,"RCAUTOP"))'=$G(^TMP("RCERA_PVW",$J,"RCAUTOP")) 0 "RTN","RCDPEWL0",140,0) Q:$G(^TMP("RCERA_PARAMS",$J,"RCMATCH"))'=$G(^TMP("RCERA_PVW",$J,"RCMATCH")) 0 "RTN","RCDPEWL0",141,0) Q:$G(^TMP("RCERA_PARAMS",$J,"RCTYPE"))'=$G(^TMP("RCERA_PVW",$J,"RCTYPE")) 0 "RTN","RCDPEWL0",142,0) Q:$G(^TMP("RCERA_PARAMS",$J,"RCPAYR"))'=$G(^TMP("RCERA_PVW",$J,"RCPAYR")) 0 "RTN","RCDPEWL0",143,0) Q:$G(^TMP("RCERA_PARAMS",$J,"RCPAYMNT"))'=$G(^TMP("RCERA_PVW",$J,"RCPAYMNT")) 0 ; PRCA*4.5*321 "RTN","RCDPEWL0",144,0) Q:$G(^TMP("RCERA_PARAMS",$J,"RCAPSTA"))'=$G(^TMP("RCERA_PVW",$J,"RCAPSTA")) 0 ; PRCA*4.5*326 "RTN","RCDPEWL0",145,0) Q 1 "RTN","RCDPEWL0",146,0) ; "RTN","RCDPEWL0",147,0) ASKUVW() ;EP from PARAMS^RCDPEWLA, PARAMS^RCDPEAA1 "RTN","RCDPEWL0",148,0) ; Prompts the user to see if they want to use their preferred view "RTN","RCDPEWL0",149,0) ; PRCA*4.5*317 added function "RTN","RCDPEWL0",150,0) ; Input: None "RTN","RCDPEWL0",151,0) ; Returns: 1 - User wants to use their preferred view "RTN","RCDPEWL0",152,0) ; 0 - User does not want to use their preferred view "RTN","RCDPEWL0",153,0) ; -1 - User typed '^' "RTN","RCDPEWL0",154,0) N DIR,DTOUT,DUOUT "RTN","RCDPEWL0",155,0) S DIR(0)="Y" "RTN","RCDPEWL0",156,0) S DIR("A")="Use preferred view" "RTN","RCDPEWL0",157,0) S DIR("B")="N" "RTN","RCDPEWL0",158,0) W ! "RTN","RCDPEWL0",159,0) D ^DIR "RTN","RCDPEWL0",160,0) I $D(DTOUT)!$D(DUOUT) Q -1 "RTN","RCDPEWL0",161,0) Q:Y 1 ; response is YES "RTN","RCDPEWL0",162,0) Q 0 "RTN","RCDPEWL0",163,0) ; "RTN","RCDPEWL0",164,0) SAVEPVW ; Option to save as User Preferred View "RTN","RCDPEWL0",165,0) ; PRCA*4.5*317 added subroutine "RTN","RCDPEWL0",166,0) ; Input: ^TMP("RCERA_PARAMS") - Global array of current worklist settings "RTN","RCDPEWL0",167,0) ; Output Current worklist settings set as preferred view (potentially) "RTN","RCDPEWL0",168,0) N DIR,DTOUT,DUOUT,RCERROR,XX "RTN","RCDPEWL0",169,0) K DIR "RTN","RCDPEWL0",170,0) S DIR(0)="YA",DIR("B")="NO" "RTN","RCDPEWL0",171,0) S DIR("A")="Do you want to save this as your preferred view (Y/N)? " "RTN","RCDPEWL0",172,0) W ! "RTN","RCDPEWL0",173,0) D ^DIR "RTN","RCDPEWL0",174,0) Q:Y'=1 "RTN","RCDPEWL0",175,0) S XX=^TMP("RCERA_PARAMS",$J,"RCPOST") "RTN","RCDPEWL0",176,0) D EN^XPAR(DUZ_";VA(200,","RCDPE EDI LOCKBOX WORKLIST","ERA_POSTING_STATUS",XX,.RCERROR) "RTN","RCDPEWL0",177,0) S XX=^TMP("RCERA_PARAMS",$J,"RCAUTOP") "RTN","RCDPEWL0",178,0) D EN^XPAR(DUZ_";VA(200,","RCDPE EDI LOCKBOX WORKLIST","ERA_AUTO_POSTING",XX,.RCERROR) "RTN","RCDPEWL0",179,0) S XX=^TMP("RCERA_PARAMS",$J,"RCMATCH") "RTN","RCDPEWL0",180,0) D EN^XPAR(DUZ_";VA(200,","RCDPE EDI LOCKBOX WORKLIST","ERA-EFT_MATCH_STATUS",XX,.RCERROR) "RTN","RCDPEWL0",181,0) S XX=^TMP("RCERA_PARAMS",$J,"RCTYPE") "RTN","RCDPEWL0",182,0) D EN^XPAR(DUZ_";VA(200,","RCDPE EDI LOCKBOX WORKLIST","ERA_CLAIM_TYPE",XX,.RCERROR) "RTN","RCDPEWL0",183,0) S XX=$TR(^TMP("RCERA_PARAMS",$J,"RCPAYR"),"^",";") "RTN","RCDPEWL0",184,0) D EN^XPAR(DUZ_";VA(200,","RCDPE EDI LOCKBOX WORKLIST","ALL_PAYERS/RANGE_OF_PAYERS",XX,.RCERROR) "RTN","RCDPEWL0",185,0) S XX=^TMP("RCERA_PARAMS",$J,"RCPAYMNT") ; PRCA*4.5*321 "RTN","RCDPEWL0",186,0) D EN^XPAR(DUZ_";VA(200,","RCDPE EDI LOCKBOX WORKLIST","ERA_PAYMENT_TYPE",XX,.RCERROR) ; PRCA*4.5*321 "RTN","RCDPEWL0",187,0) S XX=$TR(^TMP("RCERA_PARAMS",$J,"RCAPSTA"),"^",";") ; PRCA*4.5*326 "RTN","RCDPEWL0",188,0) D EN^XPAR(DUZ_";VA(200,","RCDPE EDI LOCKBOX WORKLIST","AUTO-POST_STATUS",XX,.RCERROR) ; PRCA*4.5*326 "RTN","RCDPEWL0",189,0) ; "RTN","RCDPEWL0",190,0) K ^TMP("RCERA_PVW",$J) "RTN","RCDPEWL0",191,0) M ^TMP("RCERA_PVW",$J)=^TMP("RCERA_PARAMS",$J) ; capture new preferred settings for comparison "RTN","RCDPEWL0",192,0) Q "RTN","RCDPEWL0",193,0) ; "RTN","RCDPEWL0",194,0) DTR() ; Date Range Selection "RTN","RCDPEWL0",195,0) ; Input: ^TMP("RCERA_PARAMS",$J,"RCDT") - Current selected Date Range (if any) "RTN","RCDPEWL0",196,0) ; Output: ^TMP("RCERA_PARAMS",$J,"RCDT") - Updated Selected Date Range "RTN","RCDPEWL0",197,0) ; Returns: 1 if user quit or timed out, 0 otherwise "RTN","RCDPEWL0",198,0) DTR1 ; "RTN","RCDPEWL0",199,0) N DIR,DTOUT,DTQUIT,DUOUT,Y,FROM,TO,RCDTRNG "RTN","RCDPEWL0",200,0) S ^TMP("RCERA_PARAMS",$J,"RCDT")="0^"_DT "RTN","RCDPEWL0",201,0) K DIR S DIR(0)="YA" "RTN","RCDPEWL0",202,0) S DIR("A")="Limit the selection to a date range when the ERA was received?: " "RTN","RCDPEWL0",203,0) S DIR("B")="NO" "RTN","RCDPEWL0",204,0) S DIR("?")="Enter YES to specify a date range filter." "RTN","RCDPEWL0",205,0) W ! "RTN","RCDPEWL0",206,0) D ^DIR "RTN","RCDPEWL0",207,0) I $D(DTOUT)!$D(DUOUT) Q 1 "RTN","RCDPEWL0",208,0) I Y D G:DTQUIT DTR1 "RTN","RCDPEWL0",209,0) . S DTQUIT=0 "RTN","RCDPEWL0",210,0) . S FROM=$P($G(^TMP("RCERA_PARAMS",$J,"RCDT")),"^",1) "RTN","RCDPEWL0",211,0) . S TO=$P($G(^TMP("RCERA_PARAMS",$J,"RCDT")),"^",2) "RTN","RCDPEWL0",212,0) . W ! "RTN","RCDPEWL0",213,0) . S RCDTRNG=$$DTRANGE(FROM,TO) "RTN","RCDPEWL0",214,0) . I RCDTRNG="^" S DTQUIT=1 Q "RTN","RCDPEWL0",215,0) . S ^TMP("RCERA_PARAMS",$J,"RCDT")=RCDTRNG "RTN","RCDPEWL0",216,0) Q 0 "RTN","RCDPEWL0",217,0) ; "RTN","RCDPEWL0",218,0) DTRANGE(DEFFROM,DEFTO) ; Asks for and returns a Date Range "RTN","RCDPEWL0",219,0) ; Input: DEFFROM - Default FROM date "RTN","RCDPEWL0",220,0) ; DEFTO - Default TO date "RTN","RCDPEWL0",221,0) ;Output: From_Date^To_Date (YYYMMDD^YYYDDMM) or "^" (timeout or ^ entered) "RTN","RCDPEWL0",222,0) ; "RTN","RCDPEWL0",223,0) N DIR,Y,DTOUT,DUOUT,RCDFR,START "RTN","RCDPEWL0",224,0) S RCQUIT=0 "RTN","RCDPEWL0",225,0) S DIR(0)="DAE^:"_DT_":E" "RTN","RCDPEWL0",226,0) S DIR("A")="Earliest date: " "RTN","RCDPEWL0",227,0) S DIR("?")="Enter the start of the date range." "RTN","RCDPEWL0",228,0) S:($G(DEFFROM)) DIR("B")=$$FMTE^XLFDT(DEFFROM,2) "RTN","RCDPEWL0",229,0) D ^DIR "RTN","RCDPEWL0",230,0) I $D(DTOUT)!$D(DUOUT) Q "^" "RTN","RCDPEWL0",231,0) S RCDFR=Y,START=$$FMTE^XLFDT(RCDFR,"2DZ") "RTN","RCDPEWL0",232,0) K DIR "RTN","RCDPEWL0",233,0) S DIR(0)="DAE^"_RCDFR_":"_DT_":E" "RTN","RCDPEWL0",234,0) S DIR("A")="Latest date: " "RTN","RCDPEWL0",235,0) S DIR("?",1)="Enter the end of the date range. The ending date must be greater than " "RTN","RCDPEWL0",236,0) S DIR("?")="or equal to "_START_"." "RTN","RCDPEWL0",237,0) S:($G(DEFTO)) DIR("B")=$$FMTE^XLFDT(DEFTO,2) "RTN","RCDPEWL0",238,0) D ^DIR "RTN","RCDPEWL0",239,0) I $D(DTOUT)!$D(DUOUT) Q "^" "RTN","RCDPEWL0",240,0) Q (RCDFR_"^"_Y) "RTN","RCDPEWL0",241,0) ; "RTN","RCDPEWL0",242,0) SPLIT ; Split line in ERA list "RTN","RCDPEWL0",243,0) ; input - RCSCR = ien of 344.49 and 344.4 "RTN","RCDPEWL0",244,0) N RCLINE,RCZ,RCDA,Q,Q0,Z,Z0,DIR,X,Y,CT,L,L1,RCONE,RCQUIT "RTN","RCDPEWL0",245,0) D FULL^VALM1 "RTN","RCDPEWL0",246,0) I $S($P($G(^RCY(344.4,RCSCR,4)),U,2)]"":1,1:0) D NOEDIT^RCDPEWLP G SPLITQ ;prca*4.5*298 auto-posted ERAs cannot enter Split/Edit action "RTN","RCDPEWL0",247,0) I $G(RCSCR("NOEDIT")) D NOEDIT^RCDPEWL G SPLITQ "RTN","RCDPEWL0",248,0) W !!,"Select the entry that has a line you need to Split/Edit",! "RTN","RCDPEWL0",249,0) D SEL^RCDPEWL(.RCDA) "RTN","RCDPEWL0",250,0) S Z=+$O(RCDA(0)) G:'$G(RCDA(Z)) SPLITQ "RTN","RCDPEWL0",251,0) S RCLINE=+RCDA(Z),Z0=+$O(^TMP("RCDPE-EOB_WLDX",$J,Z_".999"),-1) "RTN","RCDPEWL0",252,0) S RCZ=Z F S RCZ=$O(^TMP("RCDPE-EOB_WLDX",$J,RCZ)) Q:'RCZ!(RCZ\1'=Z) D "RTN","RCDPEWL0",253,0) . S Q=$P($G(^TMP("RCDPE-EOB_WLDX",$J,RCZ)),U,2) "RTN","RCDPEWL0",254,0) . Q:'Q "RTN","RCDPEWL0",255,0) . S RCZ(RCZ)=Q "RTN","RCDPEWL0",256,0) . S Q0=0 F S Q0=$O(^RCY(344.49,RCSCR,1,Q,1,Q0)) Q:'Q0 I "01"[$P($G(^(Q0,0)),U,2) K RCZ(RCZ) Q "RTN","RCDPEWL0",257,0) I '$O(RCZ(0)) D G SPLITQ "RTN","RCDPEWL0",258,0) . S DIR(0)="EA",DIR("A",1)="This entry has no lines available to Edit/Split",DIR("A")="PRESS RETURN TO CONTINUE " W ! D ^DIR K DIR "RTN","RCDPEWL0",259,0) S RCQUIT=0 "RTN","RCDPEWL0",260,0) I $P($G(^RCY(344.49,RCSCR,1,RCLINE,0)),U,13) D G:RCQUIT SPLITQ "RTN","RCDPEWL0",261,0) . S DIR("A",1)="WARNING! This line has already been VERIFIED",DIR("A")="Are you sure you want to continue?: ",DIR(0)="YA",DIR("B")="NO" W ! D ^DIR K DIR "RTN","RCDPEWL0",262,0) . I Y'=1 S RCQUIT=1 "RTN","RCDPEWL0",263,0) S CT=0,CT=CT+1,DIR("?",CT)="Enter the line # that you want to split or edit:",RCONE=1 "RTN","RCDPEWL0",264,0) S L=Z F S L=$O(RCZ(L)) Q:'L D "RTN","RCDPEWL0",265,0) . S L1=+$G(^TMP("RCDPE-EOB_WLDX",$J,L)) "RTN","RCDPEWL0",266,0) . S CT=CT+1 "RTN","RCDPEWL0",267,0) . S DIR("?",CT)=$G(^TMP("RCDPE-EOB_WL",$J,L1,0)),CT=CT+1,DIR("?",CT)=$G(^TMP("RCDPE-EOB_WL",$J,L1+1,0)) S RCONE(1)=$S(RCONE:L,1:"") S RCONE=0 "RTN","RCDPEWL0",268,0) S DIR("?")=" ",Y=-1 "RTN","RCDPEWL0",269,0) I $G(RCONE(1)) S Y=+RCONE(1) K DIR G:'Y SPLITQ "RTN","RCDPEWL0",270,0) I '$G(RCONE(1)) D K DIR I $D(DTOUT)!$D(DUOUT)!(Y\1'=Z) G SPLITQ "RTN","RCDPEWL0",271,0) . F S DIR(0)="NAO^"_(Z+.001)_":"_Z0_":3",DIR("A")="Which line of entry "_Z_" do you want to Split/Edit?: " S:$G(RCONE(1))'="" DIR("B")=RCONE(1) D ^DIR Q:'Y!$D(DUOUT)!$D(DTOUT) D Q:Y>0 "RTN","RCDPEWL0",272,0) .. I '$D(^TMP("RCDPE-EOB_WLDX",$J,Y)) W !!,"Line "_Y_" does NOT exist - TRY AGAIN",! S Y=-1 Q "RTN","RCDPEWL0",273,0) .. I '$D(RCZ(Y)) W !!,"Line "_Y_" has been used in a DISTRIBUTE ADJ action and can't be edited",! S Y=-1 Q "RTN","RCDPEWL0",274,0) .. S Q=+$O(^RCY(344.49,RCSCR,1,"B",Y,0)) "RTN","RCDPEWL0",275,0) ; "RTN","RCDPEWL0",276,0) K ^TMP("RCDPE_SPLIT_REBLD",$J) "RTN","RCDPEWL0",277,0) D SPLIT^RCDPEWL3(RCSCR,+Y) "RTN","RCDPEWL0",278,0) I $G(^TMP("RCDPE_SPLIT_REBLD",$J)) K ^TMP("RCDPE_SPLIT_REBLD",$J) D BLD^RCDPEWL1($G(^TMP($J,"RC_SORTPARM"))) "RTN","RCDPEWL0",279,0) ; "RTN","RCDPEWL0",280,0) SPLITQ S VALMBCK="R" "RTN","RCDPEWL0",281,0) Q "RTN","RCDPEWL0",282,0) ; "RTN","RCDPEWL0",283,0) PRTERA ; EP from menu option View/Print ERA (VP) [RCDPE VIEW/PRINT ERA] "RTN","RCDPEWL0",284,0) ; View the selected ERA in a listman template "RTN","RCDPEWL0",285,0) ; Input: RCSCR - IEN of the ERA to be viewed "RTN","RCDPEWL0",286,0) N DIC,RCSCR,X,Y "RTN","RCDPEWL0",287,0) S DIC="^RCY(344.4,",DIC(0)="AEMQ" "RTN","RCDPEWL0",288,0) D ^DIC "RTN","RCDPEWL0",289,0) Q:Y'>0 "RTN","RCDPEWL0",290,0) S RCSCR=+Y "RTN","RCDPEWL0",291,0) D PRERA1 "RTN","RCDPEWL0",292,0) Q "RTN","RCDPEWL0",293,0) ; "RTN","RCDPEWL0",294,0) PRERA ; RCSCR is assumed to be defined "RTN","RCDPEWL0",295,0) D FULL^VALM1 ; Protocol entry "RTN","RCDPEWL0",296,0) PRERA1 ; Option entry "RTN","RCDPEWL0",297,0) N DIR,X,Y,RCERADET,RCLSTMGR,POP,ZTRTN,ZTSAVE,ZTDESC,%ZIS ; PRCA*4.5*332 "RTN","RCDPEWL0",298,0) D EXCWARN^RCDPEWLP(RCSCR) "RTN","RCDPEWL0",299,0) S DIR("?",1)="Including expanded detail will significantly increase the size of this report",DIR("?",2)="IF YOU CHOOSE TO INCLUDE IT, ALL PAYMENT DETAILS FOR EACH EEOB WILL BE" "RTN","RCDPEWL0",300,0) S DIR("?")="listed. If you want just summary data for each EEOB, do NOT include it." "RTN","RCDPEWL0",301,0) S DIR(0)="YA",DIR("A")="Do you want to include expanded EEOB detail?: ",DIR("B")="NO" "RTN","RCDPEWL0",302,0) W ! "RTN","RCDPEWL0",303,0) D ^DIR "RTN","RCDPEWL0",304,0) K DIR "RTN","RCDPEWL0",305,0) I $D(DUOUT)!$D(DTOUT) G PRERAQ "RTN","RCDPEWL0",306,0) S RCERADET=+Y "RTN","RCDPEWL0",307,0) S RCLSTMGR=$$ASKLM^RCDPEARL(1) ; PRCA*4.5*332 "RTN","RCDPEWL0",308,0) I RCLSTMGR=-1 G PRERAQ ; PRCA*4.5*332 "RTN","RCDPEWL0",309,0) I RCLSTMGR D VPERA(RCSCR,RCERADET,1) Q ; PRCA*4.5*332 "RTN","RCDPEWL0",310,0) S %ZIS="QM" D ^%ZIS G:POP PRERAQ "RTN","RCDPEWL0",311,0) I $D(IO("Q")) D G PRERAQ "RTN","RCDPEWL0",312,0) . S ZTRTN="VPERA^RCDPEWL0("_RCSCR_","_RCERADET_",0)",ZTDESC="AR - Print ERA From Worklist" "RTN","RCDPEWL0",313,0) . D ^%ZTLOAD "RTN","RCDPEWL0",314,0) . W !!,$S($D(ZTSK):"Your task # "_ZTSK_" has been queued.",1:"Unable to queue this job.") "RTN","RCDPEWL0",315,0) . K ZTSK,IO("Q") D HOME^%ZIS "RTN","RCDPEWL0",316,0) U IO "RTN","RCDPEWL0",317,0) D VPERA(RCSCR,RCERADET,0) ; PRCA*4.5*332 "RTN","RCDPEWL0",318,0) Q "RTN","RCDPEWL0",319,0) ; "RTN","RCDPEWL0",320,0) VPERA(RCSCR,RCERADET,LSTMGR) ; Queued entry "RTN","RCDPEWL0",321,0) ; Input: RCSCR - IEN of ERA to be viewed (#344.4) "RTN","RCDPEWL0",322,0) ; RCERADET - 1 if inclusion of all EOB details from file 361.1 is "RTN","RCDPEWL0",323,0) ; desired, 0 if not "RTN","RCDPEWL0",324,0) ; LSTMGR - 1 display in list manager, 0 otherwise "RTN","RCDPEWL0",325,0) N RC,RCDIQ,RCDIQ1,RCDIQ2,RCDOT,RCPG,RCSCR1,RC3611,RCXM1,RCZ,RC3611,XX,Z,Z0 "RTN","RCDPEWL0",326,0) K ^TMP($J,"RC_SUMRAW"),^TMP($J,"RC_SUMOUT"),^TMP($J,"RC_SUMALL") "RTN","RCDPEWL0",327,0) S (RCSTOP,RCPG)=0,RCDOT="",$P(RCDOT,".",79)="" "RTN","RCDPEWL0",328,0) D GETS^DIQ(344.4,RCSCR_",","*","IEN","RCDIQ") "RTN","RCDPEWL0",329,0) D TXT0^RCDPEX31(RCSCR,.RCDIQ,.RCXM1,.RC) ; Get top level 0-node captioned flds "RTN","RCDPEWL0",330,0) I $O(^RCY(344.4,RCSCR,2,0)) S RC=RC+1,RCXM1(RC)=" **ERA LEVEL ADJUSTMENTS**" "RTN","RCDPEWL0",331,0) S RCSCR1=0 F S RCSCR1=$O(^RCY(344.4,RCSCR,2,RCSCR1)) Q:'RCSCR1 D "RTN","RCDPEWL0",332,0) . K RCDIQ2 "RTN","RCDPEWL0",333,0) . D GETS^DIQ(344.42,RCSCR1_","_RCSCR_",","*","IEN","RCDIQ2") "RTN","RCDPEWL0",334,0) . D TXT2^RCDPEX31(RCSCR,RCSCR1,.RCDIQ2,.RCXM1,.RC) ; Get top level ERA adjs "RTN","RCDPEWL0",335,0) S RCSCR1=0 F S RCSCR1=$O(^RCY(344.4,RCSCR,1,RCSCR1)) Q:'RCSCR1 D "RTN","RCDPEWL0",336,0) . K RCDIQ1 "RTN","RCDPEWL0",337,0) . D GETS^DIQ(344.41,RCSCR1_","_RCSCR_",","*","IE","RCDIQ1") ;PRCA*4.5*298 need to retrieve all fields even if null (changed "IEN" to "IE") "RTN","RCDPEWL0",338,0) . D TXT00^RCDPEX31(RCSCR,RCSCR1,.RCDIQ1,.RCXM1,.RC) "RTN","RCDPEWL0",339,0) . ;HIPAA 5010 "RTN","RCDPEWL0",340,0) . N PNAME4 "RTN","RCDPEWL0",341,0) . S PNAME4=$$PNM4^RCDPEWL1(RCSCR,RCSCR1) "RTN","RCDPEWL0",342,0) . I $L(PNAME4)<32 D "RTN","RCDPEWL0",343,0) . .S RC=RC+1,RCXM1(RC-1)=$E("PATIENT: "_PNAME4_$J("",41),1,41)_"CLAIM #: "_$$BILLREF^RCDPESR0(RCSCR,RCSCR1),RCXM1(RC)=" " "RTN","RCDPEWL0",344,0) . I $L(PNAME4)>31 D "RTN","RCDPEWL0",345,0) . .S RC=RC+1,RCXM1(RC-1)=$J("",41)_"CLAIM #: "_$$BILLREF^RCDPESR0(RCSCR,RCSCR1) "RTN","RCDPEWL0",346,0) . .S RC=RC+1,RCXM1(RC-1)=$E("PATIENT: "_PNAME4,1,78),RCXM1(RC)=" " "RTN","RCDPEWL0",347,0) . D PROV^RCDPEWLD(RCSCR,RCSCR1,.RCXM1,.RC) "RTN","RCDPEWL0",348,0) . S RC3611=$P($G(^RCY(344.4,RCSCR,1,RCSCR1,0)),U,2) "RTN","RCDPEWL0",349,0) . I RCERADET D "RTN","RCDPEWL0",350,0) .. I 'RC3611 D Q "RTN","RCDPEWL0",351,0) ... D DISP^RCDPESR0("^RCY(344.4,"_RCSCR_",1,"_RCSCR1_",1)","^TMP($J,""RC_SUMRAW"")",1,"^TMP($J,""RC_SUMOUT"")",75,1) "RTN","RCDPEWL0",352,0) ..; "RTN","RCDPEWL0",353,0) .. E D ; Detail record is in 361.1 "RTN","RCDPEWL0",354,0) ... K ^TMP("PRCA_EOB",$J) "RTN","RCDPEWL0",355,0) ... D GETEOB^IBCECSA6(RC3611,2) "RTN","RCDPEWL0",356,0) ... I $O(^IBM(361.1,RC3611,"ERR",0)) D GETERR^RCDPEDS(RC3611,+$O(^TMP("PRCA_EOB",$J,RC3611," "),-1)) ; get filing errors "RTN","RCDPEWL0",357,0) ... S Z=0 F S Z=$O(^TMP("PRCA_EOB",$J,RC3611,Z)) Q:'Z S RC=RC+1,^TMP($J,"RC_SUMOUT",RC)=$G(^TMP("PRCA_EOB",$J,RC3611,Z)) "RTN","RCDPEWL0",358,0) ... S RC=RC+2,^TMP($J,"RC_SUMOUT",RC-1)=" ",^TMP($J,"RC_SUMOUT",RC)=" " "RTN","RCDPEWL0",359,0) ... K ^TMP("PRCA_EOB",$J) "RTN","RCDPEWL0",360,0) . I $D(RCDIQ1(344.41,RCSCR1_","_RCSCR_",",2)) D "RTN","RCDPEWL0",361,0) .. S RC=RC+1,RCXM1(RC)=" **EXCEPTION RESOLUTION LOG DATA**" "RTN","RCDPEWL0",362,0) .. S Z=0 F S Z=$O(RCDIQ1(344.41,RCSCR1_","_RCSCR_",",2,Z)) Q:'Z S RC=RC+1,RCXM1(RC)=RCDIQ1(344.41,RCSCR1_","_RCSCR_",",2,Z) "RTN","RCDPEWL0",363,0) . S RC=RC+1,RCXM1(RC)=" " "RTN","RCDPEWL0",364,0) . S Z0=+$O(^TMP($J,"RC_SUMALL"," "),-1) "RTN","RCDPEWL0",365,0) . S Z=0 F S Z=$O(RCXM1(Z)) Q:'Z S Z0=Z0+1,^TMP($J,"RC_SUMALL",Z0)=RCXM1(Z) "RTN","RCDPEWL0",366,0) . K RCXM1 S RC=0 "RTN","RCDPEWL0",367,0) . S Z=0 F S Z=$O(^TMP($J,"RC_SUMOUT",Z)) Q:'Z S Z0=Z0+1,^TMP($J,"RC_SUMALL",Z0)=$G(^TMP($J,"RC_SUMOUT",Z)) "RTN","RCDPEWL0",368,0) I LSTMGR D DOLSTMAN,PRERAQ Q ; PRCA*4.5*332 "RTN","RCDPEWL0",369,0) S RCSTOP=0,Z="" "RTN","RCDPEWL0",370,0) F S Z=$O(^TMP($J,"RC_SUMALL",Z)) Q:'Z D Q:RCSTOP "RTN","RCDPEWL0",371,0) . I $D(ZTQUEUED),$$S^%ZTLOAD S (RCSTOP,ZTSTOP)=1 K ZTREQ I +$G(RCPG) W !!,"***TASK STOPPED BY USER***" Q "RTN","RCDPEWL0",372,0) . I 'RCPG!(($Y+5)>IOSL) D I RCSTOP Q "RTN","RCDPEWL0",373,0) .. D:RCPG ASK(.RCSTOP) I RCSTOP Q "RTN","RCDPEWL0",374,0) .. D HDR(.RCPG) "RTN","RCDPEWL0",375,0) . W !,$G(^TMP($J,"RC_SUMALL",Z)) "RTN","RCDPEWL0",376,0) ; "RTN","RCDPEWL0",377,0) I 'RCSTOP,RCPG D ASK(.RCSTOP) "RTN","RCDPEWL0",378,0) ; "RTN","RCDPEWL0",379,0) I $D(ZTQUEUED) S ZTREQ="@" "RTN","RCDPEWL0",380,0) I '$D(ZTQUEUED) D ^%ZISC "RTN","RCDPEWL0",381,0) ; "RTN","RCDPEWL0",382,0) PRERAQ K ^TMP($J,"RC_SUMRAW"),^TMP($J,"RC_SUMOUT"),^TMP($J,"SUMALL") "RTN","RCDPEWL0",383,0) S VALMBCK="R" "RTN","RCDPEWL0",384,0) Q "RTN","RCDPEWL0",385,0) ; PRCA*4.5*332 - Subroutine added "RTN","RCDPEWL0",386,0) DOLSTMAN ; Display the ERA Detail in a listman format "RTN","RCDPEWL0",387,0) N HDR "RTN","RCDPEWL0",388,0) S HDR("TITLE")="VIEW ERA DETAIL" "RTN","RCDPEWL0",389,0) D LMRPT^RCDPEARL(.HDR,$NA(^TMP($J,"RC_SUMALL")),"RCDPE VIEW ERA DETAIL") ; generate ListMan display "RTN","RCDPEWL0",390,0) Q "RTN","RCDPEWL0",391,0) ; "RTN","RCDPEWL0",392,0) HDR(RCPG) ;Report hdr "RTN","RCDPEWL0",393,0) ; RCPG = last page # "RTN","RCDPEWL0",394,0) I RCPG!($E(IOST,1,2)="C-") W @IOF,*13 "RTN","RCDPEWL0",395,0) S RCPG=$G(RCPG)+1 "RTN","RCDPEWL0",396,0) W !,?5,"EDI LOCKBOX WORKLIST - ERA DETAIL",?55,$$FMTE^XLFDT(DT,2),?70,"Page: ",RCPG,!,$TR($J("",IOM)," ","=") "RTN","RCDPEWL0",397,0) Q "RTN","RCDPEWL0",398,0) ; "RTN","RCDPEWL0",399,0) ASK(RCSTOP) ; "RTN","RCDPEWL0",400,0) I $E(IOST,1,2)'["C-" Q "RTN","RCDPEWL0",401,0) N DIR,DIROUT,DIRUT,DTOUT,DUOUT "RTN","RCDPEWL0",402,0) S DIR(0)="E" W ! D ^DIR "RTN","RCDPEWL0",403,0) I ($D(DIRUT))!($D(DUOUT)) S RCSTOP=1 Q "RTN","RCDPEWL0",404,0) Q "RTN","RCDPEWL0",405,0) ; "RTN","RCDPEWL7") 0^18^B240834871 "RTN","RCDPEWL7",1,0) RCDPEWL7 ;ALB/TMK/KML - EDI LOCKBOX WORKLIST ERA DISPLAY SCREEN ;Jun 06, 2014@19:11:19 "RTN","RCDPEWL7",2,0) ;;4.5;Accounts Receivable;**208,222,269,276,298,304,318,321,326,332**;Mar 20, 1995;Build 40 "RTN","RCDPEWL7",3,0) ;Per VA Directive 6402, this routine should not be modified. "RTN","RCDPEWL7",4,0) Q "RTN","RCDPEWL7",5,0) ; "RTN","RCDPEWL7",6,0) BLD(RCSORT) ; Build list with sort criteria "RTN","RCDPEWL7",7,0) ; RCSORT = the sort levels to use to display the data in ^ pieces "RTN","RCDPEWL7",8,0) ; piece 1 = the codes for the first level sort (sort code;null or -) "RTN","RCDPEWL7",9,0) ; piece 2 = the codes for the second level sort "RTN","RCDPEWL7",10,0) ; sort code is the type of data to sort by;- indicates reverse order "RTN","RCDPEWL7",11,0) N Z,Z1,RCT,RCZ "RTN","RCDPEWL7",12,0) S (RCT,VALMCNT)=0 "RTN","RCDPEWL7",13,0) I '$D(^TMP($J,"RCERA_LIST")) D "RTN","RCDPEWL7",14,0) . S Z=0 F S Z=$O(^TMP("RCDPE-ERA_WLDX",$J,Z)) Q:'Z S RCZ=$P($G(^(Z)),U,2) D "RTN","RCDPEWL7",15,0) .. I $$FILTER(RCZ) S ^TMP($J,"RCERA_LIST",$$SL(RCZ,$P(RCSORT,U)),$$SL(RCZ,$P(RCSORT,U,2)),RCZ)="" "RTN","RCDPEWL7",16,0) . K ^TMP("RCDPE-ERA_WLDX",$J),^TMP("RCDPE-ERA_WL",$J) "RTN","RCDPEWL7",17,0) ; "RTN","RCDPEWL7",18,0) S Z="" "RTN","RCDPEWL7",19,0) I RCSORT'["PN;-" D "RTN","RCDPEWL7",20,0) . F S Z=$O(^TMP($J,"RCERA_LIST",Z)) Q:Z="" S Z1="" F S Z1=$O(^TMP($J,"RCERA_LIST",Z,Z1)) Q:Z1="" D EXTRACT(Z,Z1,.RCT) "RTN","RCDPEWL7",21,0) ; "RTN","RCDPEWL7",22,0) I $P(RCSORT,U)["PN;-" D "RTN","RCDPEWL7",23,0) . F S Z=$O(^TMP($J,"RCERA_LIST",Z),-1) Q:Z="" S Z1="" F S Z1=$O(^TMP($J,"RCERA_LIST",Z,Z1)) Q:Z1="" D EXTRACT(Z,Z1,.RCT) "RTN","RCDPEWL7",24,0) ; "RTN","RCDPEWL7",25,0) I $P(RCSORT,U,2)["PN;-" D "RTN","RCDPEWL7",26,0) . F S Z=$O(^TMP($J,"RCERA_LIST",Z)) Q:Z="" S Z1="" F S Z1=$O(^TMP($J,"RCERA_LIST",Z,Z1),-1) Q:Z1="" D EXTRACT(Z,Z1,.RCT) "RTN","RCDPEWL7",27,0) ; "RTN","RCDPEWL7",28,0) I '$O(^TMP($J,"RCERA_LIST",0)) D SET("No ERAs left for your selection criteria") "RTN","RCDPEWL7",29,0) K ^TMP($J,"RCERA_LIST") "RTN","RCDPEWL7",30,0) S ^TMP("RCERA_PARAMS",$J,"SORT")=RCSORT "RTN","RCDPEWL7",31,0) Q "RTN","RCDPEWL7",32,0) ; "RTN","RCDPEWL7",33,0) EXTRACT(RCSRT1,RCSRT2,RCT) ; Extract the data "RTN","RCDPEWL7",34,0) ; RCSRT1 = data value at 1st sort level "RTN","RCDPEWL7",35,0) ; RCSRT2 = data value at 2nd sort level "RTN","RCDPEWL7",36,0) ; RCT = running entry counter - returned if passed by ref "RTN","RCDPEWL7",37,0) N AUTOCOMP,FIRST,MDT,RC0,RCARC,RCEFT,RCEXCEP,RCPOST,RCSTAT,RCZ,X,XX,Z,Z0 ;PRCA*4.5*318 Variable XX added "RTN","RCDPEWL7",38,0) S RCZ=0 F S RCZ=$O(^TMP($J,"RCERA_LIST",RCSRT1,RCSRT2,RCZ)) Q:'RCZ D "RTN","RCDPEWL7",39,0) . S RCT=RCT+1,RC0=$G(^RCY(344.4,RCZ,0)) "RTN","RCDPEWL7",40,0) . S RCEFT=+$O(^RCY(344.31,"AERA",RCZ,0)) "RTN","RCDPEWL7",41,0) . S MDT=$$MATCHDT^RCDPEWL7(RCEFT,"2D") ; PRCA*4.5*326 - Add date matched "RTN","RCDPEWL7",42,0) . S RCEXCEP=$$XCEPT^RCDPEWLP(RCZ) ; prca*4.5*298 assignment of ERA exception flag "RTN","RCDPEWL7",43,0) . S AUTOCOMP=$$STA(RCZ) ;PRCA*4.5*326 "RTN","RCDPEWL7",44,0) . S RCARC=$$WLF^RCDPEWLZ(RCZ) "RTN","RCDPEWL7",45,0) . S RCSTAT=$S('RCEFT:U_$S($P(RC0,U,15)="CHK":"(CHECK PAYMENT EXPECTED)",$P(RC0,U,15)="NON":"(NO PAYMENT EXPECTED)",$P(RC0,U,9)=2:"(CHECK PAYMENT CHOSEN)",1:"N/A"),1:$$FMSSTAT^RCDPUREC(+$P($G(^RCY(344.31,RCEFT,0)),U,9))) "RTN","RCDPEWL7",46,0) . S RCPOST=$S(RCEFT:"EFT RECEIPT STATUS: ",1:"")_$P(RCSTAT,U,2) "RTN","RCDPEWL7",47,0) . ;prca*4.5*298 include Auto-Post Complete indicator and ERA exception flag in $SELECT statement "RTN","RCDPEWL7",48,0) . S X=$E(RCT_$J("",5),1,5)_" "_$S(RCEXCEP]"":RCEXCEP,AUTOCOMP]"":AUTOCOMP,RCARC]"":RCARC,$D(^RCY(344.49,RCZ)):" ",1:"-")_$E($P(RC0,U)_$J("",10),1,10)_" "_$E($P(RC0,U,2)_$J("",50),1,50) "RTN","RCDPEWL7",49,0) . D SET(X,RCT,RCZ) "RTN","RCDPEWL7",50,0) . S X=$J("",43)_$J($$FMTE^XLFDT($P(RC0,U,7),"2D"),8)_$J("",2)_$J(+$P(RC0,U,5),12,2) "RTN","RCDPEWL7",51,0) . S $E(X,73,80)=$$FMTE^XLFDT($P(RC0,U,7),"2D") "RTN","RCDPEWL7",52,0) . D SET(X,RCT,RCZ) "RTN","RCDPEWL7",53,0) . ; PRCA*4.5*326 Start changed block "RTN","RCDPEWL7",54,0) . S X=$J("",8)_$E($P(RC0,U,6)_$J("",30),1,30)_" APPROX # EEOBs: "_+$$CTEEOB^RCDPEWLB(RCZ) "RTN","RCDPEWL7",55,0) . D SET(X,RCT,RCZ) "RTN","RCDPEWL7",56,0) . S X=$P(RC0,U,9),XX=$$EXTERNAL^DILFD(344.4,.09,"",$P(RC0,U,9)) "RTN","RCDPEWL7",57,0) . S XX=$S(X=1:"EFT MATCHED",X=2:"CHK MATCHED",X=3:"MATCH-0 PAY",XX=-1:"MATCH W/ERR",1:$P(XX," ",1)) "RTN","RCDPEWL7",58,0) . I X=2 S MDT=$$GET1^DIQ(344.4,RCZ_",",5.03,"I") I MDT'="" S MDT=$$FMTE^XLFDT(MDT,"2D") "RTN","RCDPEWL7",59,0) . S:$$UNBAL^RCDPEAP1(RCZ) XX=XX_" - UNBALANCED" "RTN","RCDPEWL7",60,0) . S X=$J("",8)_$E(XX_$J("",25),1,25)_" "_$E(MDT_$J("",8),1,8) "RTN","RCDPEWL7",61,0) . S X=X_" "_RCPOST "RTN","RCDPEWL7",62,0) . ; PRCA*4.5*326 End changed block "RTN","RCDPEWL7",63,0) . D SET(X,RCT) "RTN","RCDPEWL7",64,0) . D SET(" ",RCT) "RTN","RCDPEWL7",65,0) ;.; prca*4.5*298 per patch requirements, keep code related to "RTN","RCDPEWL7",66,0) ;. ; creating/maintaining batches but just remove from execution. "RTN","RCDPEWL7",67,0) ;. ;I $G(^TMP("RCERA_PARAMS",$J,"BATCHON")) D "RTN","RCDPEWL7",68,0) ;.. ;S Z=0 F S Z=$O(^RCY(344.49,RCZ,3,Z)) Q:'Z S Z0=$G(^(Z,0)) I Z0'="" D "RTN","RCDPEWL7",69,0) ;...; S X=$J("",12)_$E("- BATCH #"_$P(Z0,U)_$J("",4),1,13)_" "_$E($P(Z0,U,2)_$J("",30),1,30)_" "_$S('$P(Z0,U,3):"NOT ",1:"")_"READY TO POST" "RTN","RCDPEWL7",70,0) ;... ;D SET(X,RCT) "RTN","RCDPEWL7",71,0) ; "RTN","RCDPEWL7",72,0) S VALMSG="Enter ?? for more actions and help" ; PRCA*4.5*326 "RTN","RCDPEWL7",73,0) ; "RTN","RCDPEWL7",74,0) Q "RTN","RCDPEWL7",75,0) ; "RTN","RCDPEWL7",76,0) ; BEGIN PRCA*4.5*326 "RTN","RCDPEWL7",77,0) STA(RCZ) ;Determine auto-post status and if marked for auto-post "RTN","RCDPEWL7",78,0) ; Input - RCZ = ERA ien "RTN","RCDPEWL7",79,0) ; Output - "" = UNPOSTED "RTN","RCDPEWL7",80,0) ; "A" = COMPLETE "RTN","RCDPEWL7",81,0) ; "P" = PARTIAL "RTN","RCDPEWL7",82,0) ; "M" = MARKED "RTN","RCDPEWL7",83,0) N STA "RTN","RCDPEWL7",84,0) ;Get ERA auto-post status "RTN","RCDPEWL7",85,0) S STA=$$GET1^DIQ(344.4,RCZ_",",4.02,"I") "RTN","RCDPEWL7",86,0) ;Not auto-post ERA "RTN","RCDPEWL7",87,0) Q:STA="" "" "RTN","RCDPEWL7",88,0) ;Unposted but marked for autopost "RTN","RCDPEWL7",89,0) I STA=0,$$GET1^DIQ(344.4,RCZ_",",4.04,"I")]"" Q "M" "RTN","RCDPEWL7",90,0) ;Unposted - EFT still not accepted "RTN","RCDPEWL7",91,0) Q:STA=0 "" "RTN","RCDPEWL7",92,0) ;Complete "RTN","RCDPEWL7",93,0) Q:STA=2 "A" "RTN","RCDPEWL7",94,0) ;Partial "RTN","RCDPEWL7",95,0) N MATCH,SUB "RTN","RCDPEWL7",96,0) S MATCH=0,SUB=0 "RTN","RCDPEWL7",97,0) F S SUB=$O(^RCY(344.4,RCZ,1,SUB)) Q:'SUB D Q:MATCH "RTN","RCDPEWL7",98,0) .S MATCH=$$GET1^DIQ(344.41,SUB_","_RCZ,6,"I") "RTN","RCDPEWL7",99,0) Q $S(MATCH:"M",1:"P") "RTN","RCDPEWL7",100,0) ; END PRCA*4.5*326 "RTN","RCDPEWL7",101,0) ; "RTN","RCDPEWL7",102,0) MATCHDT(RCEFT,FORMAT) ;EP "RTN","RCDPEWL7",103,0) ; Get the Date the ERA was matched "RTN","RCDPEWL7",104,0) ; Input: RCEFT - IEN for file 344.31 "RTN","RCDPEWL7",105,0) ; FORMAT - (Optional) date format for second parameter of FMTE^XLFDT (Defaults to 2DZ) "RTN","RCDPEWL7",106,0) ; Returns: External date when the ERA was matched or "" "RTN","RCDPEWL7",107,0) I '$G(RCEFT) Q "" "RTN","RCDPEWL7",108,0) N IENS,XX "RTN","RCDPEWL7",109,0) I $G(FORMAT)="" S FORMAT="2DZ" "RTN","RCDPEWL7",110,0) S XX=$O(^RCY(344.31,RCEFT,4,"A"),-1) ; Get last Match Status History record "RTN","RCDPEWL7",111,0) Q:XX="" "" "RTN","RCDPEWL7",112,0) S IENS=XX_","_RCEFT_"," "RTN","RCDPEWL7",113,0) S XX=$$GET1^DIQ(344.314,IENS,.02,"I") "RTN","RCDPEWL7",114,0) Q:XX="" "" "RTN","RCDPEWL7",115,0) S XX=$$FMTE^XLFDT(XX,FORMAT) "RTN","RCDPEWL7",116,0) Q XX "RTN","RCDPEWL7",117,0) ; "RTN","RCDPEWL7",118,0) SL(Y,SORT) ; Returns data for sort level from entry Y in file 344.4 "RTN","RCDPEWL7",119,0) ; SORT = the sort data in ';' delimited pieces "RTN","RCDPEWL7",120,0) ; pc 1 = code for sort data "RTN","RCDPEWL7",121,0) ; pc 2 = the order requested (- or null) "RTN","RCDPEWL7",122,0) ; "RTN","RCDPEWL7",123,0) N RC0,DAT,SORT1,SORT2 "RTN","RCDPEWL7",124,0) S SORT1=$P(SORT,";"),SORT2=$P(SORT,";",2) "RTN","RCDPEWL7",125,0) S RC0=$G(^RCY(344.4,Y,0)),DAT=" " "RTN","RCDPEWL7",126,0) ; No sort "RTN","RCDPEWL7",127,0) I SORT="" G SLQ "RTN","RCDPEWL7",128,0) ; Amt paid "RTN","RCDPEWL7",129,0) I SORT1="AP" D G SLQ "RTN","RCDPEWL7",130,0) . S DAT=SORT2_+$P(RC0,U,5) "RTN","RCDPEWL7",131,0) ; ERA date pd "RTN","RCDPEWL7",132,0) I SORT1="DP" D G SLQ "RTN","RCDPEWL7",133,0) . S DAT=SORT2_($P(RC0,U,4)\1) "RTN","RCDPEWL7",134,0) ; Payer name "RTN","RCDPEWL7",135,0) I SORT1="PN" D G SLQ "RTN","RCDPEWL7",136,0) . S DAT=$$UP^RCDPEARL($P(RC0,U,6)) "RTN","RCDPEWL7",137,0) ; ERA date received "RTN","RCDPEWL7",138,0) I SORT1="DR" D G SLQ "RTN","RCDPEWL7",139,0) . S DAT=SORT2_($P(RC0,U,7)\1) "RTN","RCDPEWL7",140,0) ; "RTN","RCDPEWL7",141,0) SLQ Q $S(DAT'="":DAT,1:" ") "RTN","RCDPEWL7",142,0) ; "RTN","RCDPEWL7",143,0) INIT ; Entry point for List template to build the display of ERAs "RTN","RCDPEWL7",144,0) ; "RTN","RCDPEWL7",145,0) ; Parameters for selecting ERAs to be included in the list are "RTN","RCDPEWL7",146,0) ; contained in the global ^TMP("RCERA_PARAMS",$J,parameter name) "RTN","RCDPEWL7",147,0) ; "RTN","RCDPEWL7",148,0) N RCZ,RC0,RCT,RCTT,RCQUIT,RCDTFR,RCDTTO,DTOUT,DUOUT,DIR,X,Y,Z,Z1,RCPOST,RCEFT,RCINDX,QFLG "RTN","RCDPEWL7",149,0) D CLEAN^VALM10 "RTN","RCDPEWL7",150,0) K ^TMP("RCDPE-ERA_WL",$J),^TMP("RCDPE-ERA_WLDX",$J),^TMP($J,"RCERA_LIST") "RTN","RCDPEWL7",151,0) ; "RTN","RCDPEWL7",152,0) S (RCT,RCTT,RCQUIT)=0 "RTN","RCDPEWL7",153,0) ; "RTN","RCDPEWL7",154,0) S RCDTFR=+$P($G(^TMP("RCERA_PARAMS",$J,"RCDT")),U),RCDTTO=$S($P($G(^TMP("RCERA_PARAMS",$J,"RCDT")),U,2):$P(^("RCDT"),U,2),1:DT) "RTN","RCDPEWL7",155,0) ; "RTN","RCDPEWL7",156,0) S RCINDX=$S(RCDTFR:RCDTFR-.00000001,1:0) "RTN","RCDPEWL7",157,0) W !!,"SEARCHING, PLEASE STANDBY (PRESS '^' TO QUIT SEARCH)",!! "RTN","RCDPEWL7",158,0) F S RCINDX=$O(^RCY(344.4,"AFD",RCINDX)) Q:'RCINDX!(RCINDX\1>RCDTTO)!RCQUIT S RCZ=0 F S RCZ=$O(^RCY(344.4,"AFD",RCINDX,RCZ)) Q:'RCZ D Q:RCQUIT "RTN","RCDPEWL7",159,0) . S RCTT=RCTT+1 "RTN","RCDPEWL7",160,0) . I RCTT>19999 D Q:RCQUIT=1 "RTN","RCDPEWL7",161,0) . . S RCTT=0 "RTN","RCDPEWL7",162,0) . . D WAIT^DICD "RTN","RCDPEWL7",163,0) . . D INITKB^XGF ; supported by DBIA 3173 "RTN","RCDPEWL7",164,0) . . S QFLG=$$READ^XGF(1,1) "RTN","RCDPEWL7",165,0) . . Q:$G(DTOUT) "RTN","RCDPEWL7",166,0) . . S:QFLG="^" RCQUIT=1 Q "RTN","RCDPEWL7",167,0) . . I $D(DUOUT)!(Y=0) S RCQUIT=1 Q "RTN","RCDPEWL7",168,0) . . D RESETKB^XGF "RTN","RCDPEWL7",169,0) . ; "RTN","RCDPEWL7",170,0) . S RC0=$G(^RCY(344.4,RCZ,0)) "RTN","RCDPEWL7",171,0) . I $$FILTER(RCZ) S ^TMP($J,"RCERA_LIST",$$SL(RCZ,"DR"),$$SL(RCZ,""),RCZ)="" "RTN","RCDPEWL7",172,0) ; "RTN","RCDPEWL7",173,0) ; Output the list "RTN","RCDPEWL7",174,0) I 'RCQUIT D "RTN","RCDPEWL7",175,0) . D:$D(^TMP($J,"RCERA_LIST")) BLD("DR^N") "RTN","RCDPEWL7",176,0) . ; If no ERAs found display the message below in the list area "RTN","RCDPEWL7",177,0) . I '$O(^TMP("RCDPE-ERA_WL",$J,0)) D "RTN","RCDPEWL7",178,0) . . S ^TMP("RCDPE-ERA_WL",$J,1,0)="THERE ARE NO ERAs MATCHING YOUR SELECTION CRITERIA" S VALMCNT=2 "RTN","RCDPEWL7",179,0) I RCQUIT K ^TMP("RCDPE-ERA_WL",$J),^TMP("RCDPE-ERA_WLDX",$J),^TMP($J,"RCERA_LIST") S VALMQUIT="" "RTN","RCDPEWL7",180,0) Q "RTN","RCDPEWL7",181,0) ; "RTN","RCDPEWL7",182,0) HDR ; Header for ERA Worklist (List user Current Screen View selections) "RTN","RCDPEWL7",183,0) ; Input: ^TMP("RCERA_PARAMS",$J) "RTN","RCDPEWL7",184,0) ; Output: VALMHDR "RTN","RCDPEWL7",185,0) N X,XX,XX2 "RTN","RCDPEWL7",186,0) ; "RTN","RCDPEWL7",187,0) ; PRCA*4.5*321 - Total re-write of header subroutine to add new filters and shorten lines etc. "RTN","RCDPEWL7",188,0) ; First header line. Date range and Pharmacy/Tricare/Medical "RTN","RCDPEWL7",189,0) S X=$G(^TMP("RCERA_PARAMS",$J,"RCDT")) "RTN","RCDPEWL7",190,0) S XX="DATE RANGE : " "RTN","RCDPEWL7",191,0) I $P(X,U) D ; "RTN","RCDPEWL7",192,0) . S XX=XX_$$FMTE^XLFDT($P(X,U),2) "RTN","RCDPEWL7",193,0) . I $P(X,U,2) S XX=XX_"-"_$$FMTE^XLFDT($P(X,U,2),2) "RTN","RCDPEWL7",194,0) E S XX=XX_"NONE SELECTED" "RTN","RCDPEWL7",195,0) S X=$G(^TMP("RCERA_PARAMS",$J,"RCTYPE")) "RTN","RCDPEWL7",196,0) S XX2="MEDICAL/PHARM/TRIC: " ; PRCA*4.5*332 "RTN","RCDPEWL7",197,0) S XX2=XX2_$S(X="M":"MEDICAL ONLY",X="P":"PHARMACY ONLY",X="T":"TRICARE ONLY",1:"ALL") "RTN","RCDPEWL7",198,0) S XX=$$SETSTR^VALM1(XX2,XX,40,41) "RTN","RCDPEWL7",199,0) S VALMHDR(1)=XX "RTN","RCDPEWL7",200,0) ; "RTN","RCDPEWL7",201,0) ; Second header line. Match/Unmatched and Auto-posting/Non Autoposting "RTN","RCDPEWL7",202,0) S X=$G(^TMP("RCERA_PARAMS",$J,"RCMATCH")) "RTN","RCDPEWL7",203,0) S XX="MATCH STATUS: "_$S(X="N":"NOT MATCHED",X="M":"MATCHED",1:"BOTH") "RTN","RCDPEWL7",204,0) S X=$G(^TMP("RCERA_PARAMS",$J,"RCAUTOP")) "RTN","RCDPEWL7",205,0) S XX2="AUTO-POSTING: " "RTN","RCDPEWL7",206,0) S XX2=XX2_$S(X="A":"AUTO-POSTING ONLY",X="N":"NON AUTO-POSTING ONLY",1:"BOTH") "RTN","RCDPEWL7",207,0) S XX=$$SETSTR^VALM1(XX2,XX,46,35) "RTN","RCDPEWL7",208,0) ; BEGIN PRCA*4.5*326 "RTN","RCDPEWL7",209,0) I X'="N" D "RTN","RCDPEWL7",210,0) .S X=$G(^TMP("RCERA_PARAMS",$J,"RCAPSTA")) "RTN","RCDPEWL7",211,0) .S XX2="AUTOP: "_$S(X="P":"PARTIAL",X="C":"COMPLETE",X="M":"MARKED",1:"ALL") "RTN","RCDPEWL7",212,0) .S XX=$$SETSTR^VALM1(XX2,XX,27,15) "RTN","RCDPEWL7",213,0) ; END PRCA*4.5*326 "RTN","RCDPEWL7",214,0) S VALMHDR(2)=XX "RTN","RCDPEWL7",215,0) ; "RTN","RCDPEWL7",216,0) ; Third header line. Post status, payer name range and zero payment/payment "RTN","RCDPEWL7",217,0) S X=$G(^TMP("RCERA_PARAMS",$J,"RCPOST")) "RTN","RCDPEWL7",218,0) S XX="POST STATUS : "_$S(X="U":"UNPOSTED",X="P":"POSTED",1:"BOTH") "RTN","RCDPEWL7",219,0) S X=$G(^TMP("RCERA_PARAMS",$J,"RCPAYR")) "RTN","RCDPEWL7",220,0) I $P(X,U)="A"!(X="") D ; "RTN","RCDPEWL7",221,0) . S XX2="ALL PAYERS" "RTN","RCDPEWL7",222,0) E D ; "RTN","RCDPEWL7",223,0) . S XX2=$P(X,U,2)_"-"_$P(X,U,3) "RTN","RCDPEWL7",224,0) . I $L(XX2)>11 S XX2="RANGE" "RTN","RCDPEWL7",225,0) S XX2="PAYERS: "_XX2 "RTN","RCDPEWL7",226,0) S XX=$$SETSTR^VALM1(XX2,XX,26,20) "RTN","RCDPEWL7",227,0) S X=$G(^TMP("RCERA_PARAMS",$J,"RCPAYMNT")) "RTN","RCDPEWL7",228,0) S XX2="PAYMENT TYPE: " "RTN","RCDPEWL7",229,0) S XX2=XX2_$S(X="Z":"ZERO PAYMENTS ONLY",X="P":"PAYMENTS ONLY",1:"BOTH") "RTN","RCDPEWL7",230,0) S XX=$$SETSTR^VALM1(XX2,XX,46,35) "RTN","RCDPEWL7",231,0) S VALMHDR(3)=XX "RTN","RCDPEWL7",232,0) ; "RTN","RCDPEWL7",233,0) S VALMHDR(4)="# ERA # Trace#" "RTN","RCDPEWL7",234,0) Q "RTN","RCDPEWL7",235,0) ; "RTN","RCDPEWL7",236,0) FNL ; -- Clean up list "RTN","RCDPEWL7",237,0) K ^TMP("RCDPE-ERA_WL",$J),^TMP("RCDPE-ERA_WLDX",$J),^TMP("RCERA_PARAMS",$J),^TMP($J,"RCERA_LIST") "RTN","RCDPEWL7",238,0) Q "RTN","RCDPEWL7",239,0) ; "RTN","RCDPEWL7",240,0) SET(X,RCSEQ,RCSEQ1) ; -- set arrays "RTN","RCDPEWL7",241,0) ; X = the data to set into the global "RTN","RCDPEWL7",242,0) ; RCSEQ = the selectable line # "RTN","RCDPEWL7",243,0) ; RCSEQ1 = the ien of the entry in file 344.4 "RTN","RCDPEWL7",244,0) S VALMCNT=VALMCNT+1,^TMP("RCDPE-ERA_WL",$J,VALMCNT,0)=X "RTN","RCDPEWL7",245,0) I $G(RCSEQ) S ^TMP("RCDPE-ERA_WL",$J,"IDX",VALMCNT,RCSEQ)=$G(RCSEQ1) "RTN","RCDPEWL7",246,0) I $G(RCSEQ1) S ^TMP("RCDPE-ERA_WLDX",$J,RCSEQ)=VALMCNT_U_RCSEQ1 "RTN","RCDPEWL7",247,0) Q "RTN","RCDPEWL7",248,0) ; "RTN","RCDPEWL7",249,0) ENTERWL ; Enter the worklist with an ERA "RTN","RCDPEWL7",250,0) D WL($$SEL()) "RTN","RCDPEWL7",251,0) D BLD($G(^TMP("RCERA_PARAMS",$J,"SORT"))) "RTN","RCDPEWL7",252,0) S VALMBCK="R" "RTN","RCDPEWL7",253,0) Q "RTN","RCDPEWL7",254,0) ; "RTN","RCDPEWL7",255,0) SEL() ; Select an ERA from the ERA list "RTN","RCDPEWL7",256,0) N RCDA,VALMY "RTN","RCDPEWL7",257,0) D FULL^VALM1 "RTN","RCDPEWL7",258,0) D EN^VALM2($G(XQORNOD(0)),"S") "RTN","RCDPEWL7",259,0) S RCERA=0 "RTN","RCDPEWL7",260,0) S RCDA=0 F S RCDA=$O(VALMY(RCDA)) Q:'RCDA S RCERA=+$P($G(^TMP("RCDPE-ERA_WLDX",$J,RCDA)),U,2) "RTN","RCDPEWL7",261,0) ; "RTN","RCDPEWL7",262,0) Q RCERA "RTN","RCDPEWL7",263,0) ; "RTN","RCDPEWL7",264,0) WL(RCERA) ; Enter worklist "RTN","RCDPEWL7",265,0) ; "RTN","RCDPEWL7",266,0) ; input - RCERA = ien of the ERA entry in file 344.4 "RTN","RCDPEWL7",267,0) ; "RTN","RCDPEWL7",268,0) N DA,DIE,DIR,DR,DTOUT,DUOUT,I,PREVENT,RC0,RCNOED,RCQUIT,RCSORT,RCEXC,RETCODES,STATE,TYPE,X,Y "RTN","RCDPEWL7",269,0) Q:RCERA'>0 "RTN","RCDPEWL7",270,0) ; PRCA*4.5*304 - Reentry if we cleared exceptions "RTN","RCDPEWL7",271,0) WL1 ; retest to make sure this ERA does not have an exception "RTN","RCDPEWL7",272,0) S TYPE=$S($$PAYTYPE(RCERA,"P"):"P",1:"M"),RCEXC=0 ; PRCA*4.5*321 "RTN","RCDPEWL7",273,0) ; PRCA*4.5*304 - see if we have the ERA and go to WL1 to retest. "RTN","RCDPEWL7",274,0) I ($$XCEPT^RCDPEWLP(RCERA)]"")&(TYPE="M") D EXCDENY^RCDPEWLP Q ;cannot process MEDICAL ERA if exception exists then fall back to Worklist. "RTN","RCDPEWL7",275,0) ; PRCA*4.5*304 - Removed the G:($G(RCERA)'="")&&($G(RCEXC)=1) WL1 from above so it falls back to the worklist instead of going forward to the "Select ERA" "RTN","RCDPEWL7",276,0) ; I ($$XCEPT^RCDPEWLP(RCERA)]"")&(TYPE="M") D EXCDENY^RCDPEWLP G:($G(RCERA)'="")&&($G(RCEXC)=1) WL1 Q "RTN","RCDPEWL7",277,0) S (RCQUIT,RCNOED,PREVENT)=0,RC0=$G(^RCY(344.4,RCERA,0)),RCSORT="" "RTN","RCDPEWL7",278,0) I $P(RC0,U,8) D "RTN","RCDPEWL7",279,0) . I '$D(^RCY(344.49,RCERA,0)) D Q "RTN","RCDPEWL7",280,0) .. S RCQUIT=1 "RTN","RCDPEWL7",281,0) .. W ! S DIR(0)="EA",DIR("A",1)="A SCRATCH PAD WAS NOT CREATED FOR THIS ERA BEFORE POSTING",DIR("A",2)="USE THE VIEW/PRINT ERA OPTION TO SEE ITS DETAIL",DIR("A")="Press ENTER to continue: " D ^DIR K DIR Q "RTN","RCDPEWL7",282,0) . ; "RTN","RCDPEWL7",283,0) . S RCNOED=+$P(RC0,U,8) "RTN","RCDPEWL7",284,0) . S DIR(0)="EA",DIR("A",1)="THIS ERA ALREADY HAS A RECEIPT - YOU MAY ONLY VIEW ITS SCRATCH PAD",DIR("A")="Press ENTER to continue: " "RTN","RCDPEWL7",285,0) . W ! D ^DIR K DIR W ! "RTN","RCDPEWL7",286,0) G:RCQUIT WLQ "RTN","RCDPEWL7",287,0) G:RCNOED WLD ; already has a receipt so no need to check for older unposted EFTs "RTN","RCDPEWL7",288,0) ; function $$AGEDEFTS - search for any UNPOSTED EFTs older than 14 days (medical) or 30 days (pharmacy) "RTN","RCDPEWL7",289,0) ; return value of 0, 2, or 3 represent that entry into scratchpad can occur "RTN","RCDPEWL7",290,0) S TYPE=$S(TYPE="P":"P",$$PAYTYPE(RCERA,"T"):"T",1:"M") ; PRCA*4.5*332 "RTN","RCDPEWL7",291,0) S RETCODES=$$AGEDEFTS^RCDPEWLP(RCERA,TYPE) ; PRCA*4.5*332 "RTN","RCDPEWL7",292,0) S PREVENT=0 "RTN","RCDPEWL7",293,0) F I=1:1 S STATE=$P(RETCODES,U,I) Q:STATE="" I $E(STATE,2)=TYPE,$E(STATE,1)=1 S PREVENT=1 ; PRCA*4.5*332 "RTN","RCDPEWL7",294,0) Q:PREVENT ; prevent user from entering scratchpad; there are older EFTs on the system that need to be worked. "RTN","RCDPEWL7",295,0) WLD ; "RTN","RCDPEWL7",296,0) D DISP^RCDPEWL(RCERA,RCNOED) "RTN","RCDPEWL7",297,0) ; "RTN","RCDPEWL7",298,0) ; prca*4.5*298 per patch requirements, keep code related to "RTN","RCDPEWL7",299,0) ; creating/maintaining batches but just remove from execution. "RTN","RCDPEWL7",300,0) ;I 'RCQUIT,$G(^TMP("RCBATCH_SELECTED",$J)) D "RTN","RCDPEWL7",301,0) ;. S DA(1)=RCERA,DA=+$G(^TMP("RCBATCH_SELECTED",$J)),DR=".05////0",DIE="^RCY(344.49,"_DA(1)_",3," D ^DIE "RTN","RCDPEWL7",302,0) ;. L -^RCY(344.49,DA(1),3,DA,0) "RTN","RCDPEWL7",303,0) ;. K ^TMP("RCBATCH_SELECTED",$J) "RTN","RCDPEWL7",304,0) ;E D "RTN","RCDPEWL7",305,0) ;L -^RCY(344.4,RCERA,0) "RTN","RCDPEWL7",306,0) WLQ ; "RTN","RCDPEWL7",307,0) L -^RCY(344.4,RCERA,0) "RTN","RCDPEWL7",308,0) Q "RTN","RCDPEWL7",309,0) ; "RTN","RCDPEWL7",310,0) PRERA ; View/Print ERA from ERA list menu "RTN","RCDPEWL7",311,0) N RCSCR "RTN","RCDPEWL7",312,0) S RCSCR=$$SEL() "RTN","RCDPEWL7",313,0) I RCSCR>0 D PRERA^RCDPEWL0 "RTN","RCDPEWL7",314,0) S VALMBCK="R" "RTN","RCDPEWL7",315,0) Q "RTN","RCDPEWL7",316,0) ; "RTN","RCDPEWL7",317,0) BAT(RCERA) ; Select batch, if needed "RTN","RCDPEWL7",318,0) ; Returns 1 if batch selected OK or no batch needed "RTN","RCDPEWL7",319,0) ; RCERA = ien of entry in file 344.49 "RTN","RCDPEWL7",320,0) N RCINUSE,RCQUIT,RCADJ,RC0,RCOK,DIR,DTOUT,DUOUT,X,Y,Z "RTN","RCDPEWL7",321,0) K ^TMP("RCBATCH_SELECTED",$J) "RTN","RCDPEWL7",322,0) S RCOK=1 "RTN","RCDPEWL7",323,0) I '$O(^RCY(344.49,RCERA,3,0)) G BATQ "RTN","RCDPEWL7",324,0) S RC0=$G(^RCY(344.4,RCERA,0)) "RTN","RCDPEWL7",325,0) S (RCQUIT,RCADJ)=0 "RTN","RCDPEWL7",326,0) I $$HASADJ^RCDPEWL8(RCERA) D "RTN","RCDPEWL7",327,0) . S RCADJ=1 "RTN","RCDPEWL7",328,0) . S DIR("A",1)="THIS ERA HAS NEGATIVE ADJUSTMENTS THAT NEED TO BE DISTRIBUTED TO OTHER",DIR("A",2)="PAYMENTS ON THE ERA. YOU CANNOT SELECT ANY INDIVIDUAL BATCHES UNTIL",DIR("A",3)="THE DISTRIBUTIONS ARE COMPLETE." "RTN","RCDPEWL7",329,0) . S DIR("A")="Press ENTER to continue: ",DIR(0)="EA" W ! D ^DIR K DIR "RTN","RCDPEWL7",330,0) S RCINUSE=+$O(^RCY(344.49,"AINUSE",1,RCERA,0)) "RTN","RCDPEWL7",331,0) I RCINUSE D "RTN","RCDPEWL7",332,0) . N OK,Z "RTN","RCDPEWL7",333,0) . Q:RCADJ!$P(RC0,U,8) "RTN","RCDPEWL7",334,0) . S OK=0 S Z=0 F S Z=$O(^RCY(344.49,RCERA,3,Z)) Q:'Z I '$P($G(^RCY(344.49,RCERA,3,Z,0)),U,5) S OK=1 Q "RTN","RCDPEWL7",335,0) . I 'OK D Q "RTN","RCDPEWL7",336,0) .. S DIR("A",1)="ALL BATCHES WITHIN THIS ERA ARE CURRENTLY IN USE - TRY AGAIN LATER",DIR("A")="Press ENTER to continue: ",DIR(0)="EA" W ! D ^DIR K DIR S RCQUIT=1,RCOK=0 Q "RTN","RCDPEWL7",337,0) . W !!,"AT LEAST 1 BATCH WITHIN THIS ERA IS CURRENTLY IN USE",!,"AT THIS TIME, YOU CAN ONLY ACCESS INDIVIDUAL BATCHES",! "RTN","RCDPEWL7",338,0) . D SELBAT^RCDPEWL8(RCERA,.RCQUIT) "RTN","RCDPEWL7",339,0) . I RCQUIT S RCOK=0 "RTN","RCDPEWL7",340,0) E D "RTN","RCDPEWL7",341,0) . Q:$P(RC0,U,8)!RCADJ ; Always require the entire ERA be used "RTN","RCDPEWL7",342,0) . S DIR(0)="SA^E:(E)NTIRE ERA;B:(B)ATCH",DIR("A")="DO YOU WANT THE (E)NTIRE ERA OR JUST A (B)ATCH?: " W ! D ^DIR K DIR "RTN","RCDPEWL7",343,0) . I $D(DTOUT)!$D(DUOUT) S RCQUIT=1,RCOK=0 Q "RTN","RCDPEWL7",344,0) . I Y="E" D Q "RTN","RCDPEWL7",345,0) .. S RCQUIT=1 F Z=1:1:2 L +^RCY(344.4,RCERA,0):5 I $T S RCQUIT=0 Q "RTN","RCDPEWL7",346,0) .. I RCQUIT S RCOK=0,DIR(0)="EA",DIR("A",1)="ANOTHER USER IS CURRENTLY USING THIS ERA, TRY AGAIN LATER",DIR("A")="Press ENTER to continue: " W ! D ^DIR K DIR Q "RTN","RCDPEWL7",347,0) . D SELBAT^RCDPEWL8(RCERA,.RCQUIT) "RTN","RCDPEWL7",348,0) . I RCQUIT S RCOK=0 "RTN","RCDPEWL7",349,0) ; "RTN","RCDPEWL7",350,0) BATQ Q RCOK "RTN","RCDPEWL7",351,0) ; "RTN","RCDPEWL7",352,0) PAYTYPE(IEN,TYPE) ; EP - New way to tell if a payer is pharamcy, Tricare or medical - Added for PRCA*4.5*321 "RTN","RCDPEWL7",353,0) ; Input: IEN - Internal entry number of an ERA (#344.4) "RTN","RCDPEWL7",354,0) ; TYPE="P" - Pharmacy, "T" - Tricare, "M" - Medical "RTN","RCDPEWL7",355,0) ; ("M" is neither pharmacy nor Tricare) "RTN","RCDPEWL7",356,0) ; Return: 1 - Payer on ERA matches the TYPE "RTN","RCDPEWL7",357,0) ; 0 - Payer on ERA does not match the type. Or can't find payer. "RTN","RCDPEWL7",358,0) ; "RTN","RCDPEWL7",359,0) N FLAG,RETURN "RTN","RCDPEWL7",360,0) S RETURN=0 "RTN","RCDPEWL7",361,0) I '$$PAYFLAGS(IEN,.FLAG) Q 0 "RTN","RCDPEWL7",362,0) I TYPE="P",FLAG("P") S RETURN=1 "RTN","RCDPEWL7",363,0) I TYPE="T",FLAG("T") S RETURN=1 "RTN","RCDPEWL7",364,0) I TYPE="M",'FLAG("P"),'FLAG("T") S RETURN=1 "RTN","RCDPEWL7",365,0) Q RETURN "RTN","RCDPEWL7",366,0) ; "RTN","RCDPEWL7",367,0) PAYFLAGS(IEN,FLAG) ; EP - Return the pharmacy and tricare flags for an ERA "RTN","RCDPEWL7",368,0) ; Input: IEN - Internal entry number of an ERA (#344.4) "RTN","RCDPEWL7",369,0) ; Return: 1 - Payer found "RTN","RCDPEWL7",370,0) ; 0 - Can't find payer. "RTN","RCDPEWL7",371,0) ; Variable FLAG passed by reference to return values of the pharmacy and Tricare flags. "RTN","RCDPEWL7",372,0) ; "RTN","RCDPEWL7",373,0) N RCINS,RCPAYIEN,RCTIN,X "RTN","RCDPEWL7",374,0) S RCTIN=$$GET1^DIQ(344.4,IEN_",",.03) "RTN","RCDPEWL7",375,0) I RCTIN="" Q 0 "RTN","RCDPEWL7",376,0) S RCINS=$$GET1^DIQ(344.4,IEN_",",.06) "RTN","RCDPEWL7",377,0) I RCINS="" Q 0 "RTN","RCDPEWL7",378,0) ; "RTN","RCDPEWL7",379,0) ; Find a payer that matches both TIN and PAYER NAME from the ERA "RTN","RCDPEWL7",380,0) S RCPAYIEN="" "RTN","RCDPEWL7",381,0) S X=0 "RTN","RCDPEWL7",382,0) F S X=$O(^RCY(344.6,"C",RCTIN_" ",X)) Q:'X D Q:RCPAYIEN ; "RTN","RCDPEWL7",383,0) . N PAYNAME "RTN","RCDPEWL7",384,0) . S PAYNAME=$$GET1^DIQ(344.6,X_",",.01) "RTN","RCDPEWL7",385,0) . I PAYNAME=RCINS S RCPAYIEN=X "RTN","RCDPEWL7",386,0) I 'RCPAYIEN Q 0 "RTN","RCDPEWL7",387,0) ; "RTN","RCDPEWL7",388,0) S FLAG("P")=+$$GET1^DIQ(344.6,RCPAYIEN_",",.09,"I") "RTN","RCDPEWL7",389,0) S FLAG("T")=+$$GET1^DIQ(344.6,RCPAYIEN_",",.1,"I") "RTN","RCDPEWL7",390,0) Q 1 "RTN","RCDPEWL7",391,0) ; "RTN","RCDPEWL7",392,0) ; BEGIN PRCA*4.5*326 "RTN","RCDPEWL7",393,0) HELP ; list manager help "RTN","RCDPEWL7",394,0) D FULL^VALM1 "RTN","RCDPEWL7",395,0) S VALMBCK="R" "RTN","RCDPEWL7",396,0) W @IOF "RTN","RCDPEWL7",397,0) W !,"ePay Electronic Remittance Advice Status" "RTN","RCDPEWL7",398,0) W !!,"The following ERA Status indicators may appear to the left of ERA number:",! "RTN","RCDPEWL7",399,0) ; "RTN","RCDPEWL7",400,0) W !," '-' = No scratchpad." "RTN","RCDPEWL7",401,0) W !," 'x' = EXC exceptions exist." "RTN","RCDPEWL7",402,0) W !," 'c' = No-pay ERA with auto-decrease CARCs." "RTN","RCDPEWL7",403,0) W !," 'A' = Auto-post complete." "RTN","RCDPEWL7",404,0) W !," 'P' = Auto-post partially completed." "RTN","RCDPEWL7",405,0) W !," 'M' = Marked for Auto-post, waiting processing." "RTN","RCDPEWL7",406,0) D PAUSE^VALM1 "RTN","RCDPEWL7",407,0) Q "RTN","RCDPEWL7",408,0) ; Following FILTER code moved from RCDPEWL0 due to routine size "RTN","RCDPEWL7",409,0) FILTER(IEN344P4) ; Returns 1 if record in entry IEN344P4 in 344.4 passes "RTN","RCDPEWL7",410,0) ; the edits for the worklist selection of ERAs "RTN","RCDPEWL7",411,0) ; Parameters found in ^TMP("RCERA_PARAMS",$J) "RTN","RCDPEWL7",412,0) N OK,RCPOST,RCAPST,RCAPSTA,RCAUTOP,RCMATCH,RCTYPE,RCDFR,RCDTO,RCPAYFR,RCPAYMNT,RCPAYTO,RCPAYR,RC0,RC4 "RTN","RCDPEWL7",413,0) S OK=1,RC0=$G(^RCY(344.4,IEN344P4,0)),RC4=$G(^RCY(344.4,IEN344P4,4)) "RTN","RCDPEWL7",414,0) ; "RTN","RCDPEWL7",415,0) S RCMATCH=$G(^TMP("RCERA_PARAMS",$J,"RCMATCH")),RCPOST=$G(^TMP("RCERA_PARAMS",$J,"RCPOST")) "RTN","RCDPEWL7",416,0) S RCAUTOP=$G(^TMP("RCERA_PARAMS",$J,"RCAUTOP")),RCTYPE=$G(^TMP("RCERA_PARAMS",$J,"RCTYPE")) "RTN","RCDPEWL7",417,0) S RCDFR=+$P($G(^TMP("RCERA_PARAMS",$J,"RCDT")),U),RCDTO=+$P($G(^TMP("RCERA_PARAMS",$J,"RCDT")),U,2) "RTN","RCDPEWL7",418,0) S RCPAYR=$P($G(^TMP("RCERA_PARAMS",$J,"RCPAYR")),U),RCPAYFR=$P($G(^TMP("RCERA_PARAMS",$J,"RCPAYR")),U,2),RCPAYTO=$P($G(^TMP("RCERA_PARAMS",$J,"RCPAYR")),U,3) "RTN","RCDPEWL7",419,0) S RCPAYMNT=$G(^TMP("RCERA_PARAMS",$J,"RCPAYMNT")) ; PRCA*4.5*321 "RTN","RCDPEWL7",420,0) S RCAPSTA=$G(^TMP("RCERA_PARAMS",$J,"RCAPSTA")) "RTN","RCDPEWL7",421,0) ; "RTN","RCDPEWL7",422,0) ; Post status "RTN","RCDPEWL7",423,0) I $S(RCPOST="B":0,RCPOST="U":$P(RC0,U,14),1:'$P(RC0,U,14)) S OK=0 G FQ "RTN","RCDPEWL7",424,0) ; Auto-Posting status "RTN","RCDPEWL7",425,0) I $S(RCAUTOP="B":0,RCAUTOP="A":($P(RC4,U,2)=""),1:($P(RC4,U,2)'="")) S OK=0 G FQ "RTN","RCDPEWL7",426,0) ; If ERA is autopost and filtering on selected Autopost statuses check status "RTN","RCDPEWL7",427,0) I $P(RC4,U,2)'="",RCAPSTA'="A",(RCAUTOP="B")!(RCAUTOP="A") D G:OK=0 FQ "RTN","RCDPEWL7",428,0) .;Auto-post Status "RTN","RCDPEWL7",429,0) .S RCAPST=$$GET1^DIQ(344.4,IEN344P4_",",4.02,"I") "RTN","RCDPEWL7",430,0) .;Complete filter "RTN","RCDPEWL7",431,0) .I RCAPSTA="C" S:RCAPST'=2 OK=0 G FQ "RTN","RCDPEWL7",432,0) .;Partial filter "RTN","RCDPEWL7",433,0) .I RCAPSTA="P" S:RCAPST'=1 OK=0 G FQ "RTN","RCDPEWL7",434,0) .;Marked for Auto-post filter - ignores if not partial post or unposted "RTN","RCDPEWL7",435,0) .I RCAPSTA="M",RCAPST'=1,RCAPST'=0 S OK=0 G FQ "RTN","RCDPEWL7",436,0) .;Marked for Auto-post filter - ignores PARTIAL auto-post era if no lines on ERA are marked "RTN","RCDPEWL7",437,0) .I RCAPSTA="M",RCAPST=1,'$O(^RCY(344.4,"AP",1,IEN344P4,"")) S OK=0 G FQ "RTN","RCDPEWL7",438,0) .;Marked for Auto-post filter - ignores UNPROCESSED auto-post era if no marked for autopost user "RTN","RCDPEWL7",439,0) .I RCAPSTA="M",RCAPST=0,$$GET1^DIQ(344.4,IEN344P4_",",4.04,"I")="" S OK=0 G FQ "RTN","RCDPEWL7",440,0) ; Match status "RTN","RCDPEWL7",441,0) I $S(RCMATCH="B":0,RCMATCH="N":$P(RC0,U,9),1:'$P(RC0,U,9)) S OK=0 G FQ "RTN","RCDPEWL7",442,0) ; Medical/Pharmacy/Tricare Claim "RTN","RCDPEWL7",443,0) ; I $S(RCTYPE="B":0,RCTYPE="M":$$PHARM^RCDPEWLP(IEN344P4),1:'$$PHARM^RCDPEWLP(IEN344P4)) S OK=0 G FQ "RTN","RCDPEWL7",444,0) I RCTYPE'="A" D I 'OK G FQ "RTN","RCDPEWL7",445,0) . N RCFLAG "RTN","RCDPEWL7",446,0) . I '$$PAYFLAGS^RCDPEWL7(IEN344P4,.RCFLAG) S OK=0 Q "RTN","RCDPEWL7",447,0) . I RCTYPE="P",'RCFLAG("P") S OK=0 Q "RTN","RCDPEWL7",448,0) . I RCTYPE="T",'RCFLAG("T") S OK=0 Q "RTN","RCDPEWL7",449,0) . I RCTYPE="M",(RCFLAG("P")!RCFLAG("T")) S OK=0 "RTN","RCDPEWL7",450,0) ; dt rec'd range "RTN","RCDPEWL7",451,0) I $S(RCDFR=0:0,1:$P(RC0,U,7)\1RCDTO) S OK=0 G FQ "RTN","RCDPEWL7",453,0) ; Payer name "RTN","RCDPEWL7",454,0) I RCPAYR'="A" D G:'OK FQ "RTN","RCDPEWL7",455,0) . N Q "RTN","RCDPEWL7",456,0) . S Q=$$UP^RCDPEARL($P(RC0,U,6)) "RTN","RCDPEWL7",457,0) . I $S(Q=RCPAYFR:1,Q=RCPAYTO:1,Q]RCPAYFR:RCPAYTO]Q,1:0) Q "RTN","RCDPEWL7",458,0) . S OK=0 "RTN","RCDPEWL7",459,0) ; PRCA*4.5*321 - Start modified code block "RTN","RCDPEWL7",460,0) ; Zero amount or payment "RTN","RCDPEWL7",461,0) I RCPAYMNT'="B" D ; "RTN","RCDPEWL7",462,0) . I RCPAYMNT="Z",$P(RC0,U,5) S OK=0 Q "RTN","RCDPEWL7",463,0) . I RCPAYMNT="P",'$P(RC0,U,5) S OK=0 "RTN","RCDPEWL7",464,0) ; PRCA*4.5*321 - End modified code block "RTN","RCDPEWL7",465,0) ; "RTN","RCDPEWL7",466,0) FQ Q OK "RTN","RCDPEWL7",467,0) ; END PRCA*4.5*326 "RTN","RCDPEWLD") 0^48^B136795643 "RTN","RCDPEWLD",1,0) RCDPEWLD ;ALB/CLT - Continuation of routine RCDPEWL0 ;09 DEC 2016 "RTN","RCDPEWLD",2,0) ;;4.5;Accounts Receivable;**252,317,321,326,332**;Mar 20, 1995;Build 40 "RTN","RCDPEWLD",3,0) ;Per VA Directive 6402, this routine should not be modified. "RTN","RCDPEWLD",4,0) Q "RTN","RCDPEWLD",5,0) ; "RTN","RCDPEWLD",6,0) PROV(RCSCR,RCSCR1,RCXM1,RC) ;Get prov data from ERA (FILE 344.4) and claim (FILE 399) "RTN","RCDPEWLD",7,0) N RCXXX,RCYYY,RCDPEPV,RCCLAIM,RCIEN,RCBILL,RCID,RCBLANK,RCNPI,DIC,X,Y "RTN","RCDPEWLD",8,0) N RCPROV,RCEXP,XUSNPI,RCRTN,RCBNM,RCCOM1,RCCOM2,RCWARN,RCYNODE3 "RTN","RCDPEWLD",9,0) ; "RTN","RCDPEWLD",10,0) S RCBLANK="" F X=1:1:30 S RCBLANK=RCBLANK_" " "RTN","RCDPEWLD",11,0) S RC=RC+1 S RCXM1(RC-1)=RCBLANK "RTN","RCDPEWLD",12,0) S RCYNODE3=$G(^RCY(344.4,RCSCR,1,RCSCR1,3)) "RTN","RCDPEWLD",13,0) ; "RTN","RCDPEWLD",14,0) LKBOX ;Get provider data from ELECTRONIC REMITTANCE ADVICE file (#344.4) "RTN","RCDPEWLD",15,0) S RC=RC+1,RCXM1(RC-1)=$E("**EOB PROVIDER(S)/NPI"_$J(" ",39),1,39)_"CLAIM PROVIDER(S)/NPI**" ;setting sub-header for worklist "RTN","RCDPEWLD",16,0) S RC=RC+1,RCXM1(RC-1)=$E("---------------------"_$J(" ",39),1,39)_"-----------------------" "RTN","RCDPEWLD",17,0) ; "RTN","RCDPEWLD",18,0) S RCPROV="BILLING",$P(RCYYY(RCPROV),U,3)=0 ; piece 3 initialize for error msgs "RTN","RCDPEWLD",19,0) I $P(RCYNODE3,U)'="" S RCYYY(RCPROV)="/"_$P(RCYNODE3,U) ; Billing Prov NPI "RTN","RCDPEWLD",20,0) ; "RTN","RCDPEWLD",21,0) S RCPROV="RENDERING" "RTN","RCDPEWLD",22,0) I $P(RCYNODE3,U,3)=2 S RCPROV="SERVICING" "RTN","RCDPEWLD",23,0) I $P(RCYNODE3,U,3)="",($P(RCYNODE3,U,4)'[","),($P(RCYNODE3,U,4)'="") S RCPROV="SERVICING" "RTN","RCDPEWLD",24,0) I $P(RCYNODE3,U,2)'=""!($P(RCYNODE3,U,4)'="") S RCYYY(RCPROV)=$E($P(RCYNODE3,U,4),1,20)_"/"_$P(RCYNODE3,U,2) "RTN","RCDPEWLD",25,0) S $P(RCYYY(RCPROV),U,3)=0 ; initialize for error msgs "RTN","RCDPEWLD",26,0) D NPICHK ; RCPROV has to be "RENDERING" or "SERVICING" when this tag is called ! "RTN","RCDPEWLD",27,0) ; "RTN","RCDPEWLD",28,0) CLAIM ;Retrieve provider data from the claim "RTN","RCDPEWLD",29,0) S RCCLAIM=$$GET1^DIQ(361.1,$P(^RCY(344.4,RCSCR,1,RCSCR1,0),U,2),.01) ;determine claim num based on entry in 344.4 "RTN","RCDPEWLD",30,0) S DIC="^DGCR(399,",DIC(0)="",X=RCCLAIM D ^DIC S RCCLAIM=+Y ;find ien for file 399 "RTN","RCDPEWLD",31,0) D GETS^DIQ(399,RCCLAIM,"222*","IE","RCXXX") ;retrieve prov information "RTN","RCDPEWLD",32,0) S RCBILL=$$GET1^DIQ(399,RCCLAIM,.22,"I") ;retrieve default division "RTN","RCDPEWLD",33,0) S RCBNM=$$GET1^DIQ(4,$$GET1^DIQ(40.8,RCBILL,.07,"I"),.01) ;get name from institution file "RTN","RCDPEWLD",34,0) S RCBILL=$$GET1^DIQ(4,$$GET1^DIQ(40.8,RCBILL,.07,"I"),41.99) ;get NPI from institution file "RTN","RCDPEWLD",35,0) ; "RTN","RCDPEWLD",36,0) S $P(RCYYY("BILLING"),U,2)=RCBNM_"/"_RCBILL_"^"_0 ;NPI set into local array "RTN","RCDPEWLD",37,0) I $D(RCXXX) S RCPROV="" F S RCPROV=$O(RCXXX(399.0222,RCPROV)) Q:RCPROV="" D ;loop through claim providers "RTN","RCDPEWLD",38,0) . S RCIEN=$P(RCXXX(399.0222,RCPROV,.02,"I"),";",1) "RTN","RCDPEWLD",39,0) . S RCID=$S($P(RCXXX(399.0222,RCPROV,.02,"I"),";",2)["VA(200":"Individual_ID",1:"Non_VA_Provider_ID") "RTN","RCDPEWLD",40,0) . S RCNPI=$$NPI^XUSNPI(RCID,RCIEN) ;retrieve provider NPI "RTN","RCDPEWLD",41,0) . S $P(RCYYY(RCXXX(399.0222,RCPROV,.01,"E")),U,2)=$E(RCXXX(399.0222,RCPROV,.02,"E"),1,20)_"/"_$S(+RCNPI=0:"No NPI on file",+RCNPI=-1:"Can't look up NPI",1:+RCNPI) "RTN","RCDPEWLD",42,0) . S:$P(RCYYY(RCXXX(399.0222,RCPROV,.01,"E")),U,3)="" $P(RCYYY(RCXXX(399.0222,RCPROV,.01,"E")),U,3)=0 "RTN","RCDPEWLD",43,0) LINESET ;SET THE PRINT LINES "RTN","RCDPEWLD",44,0) S (RCWARN,RCPROV)="" F S RCPROV=$O(RCYYY(RCPROV)) Q:RCPROV="" D ;loop through the found provider types "RTN","RCDPEWLD",45,0) . S RC=RC+1 ;increment line counter "RTN","RCDPEWLD",46,0) . ; build display detail line "RTN","RCDPEWLD",47,0) . S RCXM1(RC-1)=RCPROV_": "_$P(RCYYY(RCPROV),U,1) "RTN","RCDPEWLD",48,0) . I $L(RCXM1(RC-1))>39 D "RTN","RCDPEWLD",49,0) .. S RCXM1(RC-1)=$E($P(RCXM1(RC-1),"/"),1,27)_"/"_$P(RCXM1(RC-1),"/",2) "RTN","RCDPEWLD",50,0) . S RCXM1(RC-1)=$E(RCXM1(RC-1)_RCBLANK,1,39)_$P(RCYYY(RCPROV),U,2) "RTN","RCDPEWLD",51,0) . I $P(RCYYY(RCPROV),U,3)'=0 S RCWARN=$P(RCYYY(RCPROV),U,3) "RTN","RCDPEWLD",52,0) I RCWARN'="" D "RTN","RCDPEWLD",53,0) . S RC=RC+1,RCXM1(RC-1)=" " ;Blank line for separation "RTN","RCDPEWLD",54,0) . S RC=RC+1,RCXM1(RC-1)="Rendering/Servicing Provider NPI Warning:" "RTN","RCDPEWLD",55,0) . S RC=RC+1,RCXM1(RC-1)=RCWARN "RTN","RCDPEWLD",56,0) S RC=RC+1,RCXM1(RC-1)=" " ;Blank line to separate from possible comments "RTN","RCDPEWLD",57,0) S RCCOM1=$P(RCYNODE3,U,5),RCCOM2=$P(RCYNODE3,U,6) D ;Error in NPI format "RTN","RCDPEWLD",58,0) . I $G(RCCOM1)'="" S RC=RC+1,RCXM1(RC-1)=RCCOM1 "RTN","RCDPEWLD",59,0) . I $G(RCCOM2)'="" S RC=RC+1,RCXM1(RC-1)=RCCOM2 "RTN","RCDPEWLD",60,0) Q "RTN","RCDPEWLD",61,0) ; "RTN","RCDPEWLD",62,0) NPICHK ;CHECK THAT THE NPI RETURNED MATCHES THE ENTITY TYPE QUALIFIER "RTN","RCDPEWLD",63,0) S RCEXP="" Q:$P(RCYNODE3,U,3)="" ; ENTITY TYPE QUALIFIER "RTN","RCDPEWLD",64,0) ; "RTN","RCDPEWLD",65,0) S RCCOM2=$P(RCYNODE3,U,6) ; Ren/Serv comment "RTN","RCDPEWLD",66,0) S XUSNPI=$P(RCYNODE3,U,2) "RTN","RCDPEWLD",67,0) I RCCOM2="",(XUSNPI="") S RCEXP="**NO SERVICING/RENDERING NPI INCLUDED IN 835**" D EXPSET Q "RTN","RCDPEWLD",68,0) S RCRTN=$$QI^XUSNPI(XUSNPI) "RTN","RCDPEWLD",69,0) I $P(RCRTN,U,1)="Individual_ID" D Q "RTN","RCDPEWLD",70,0) . I $P(RCYNODE3,U,3)'=1 S RCEXP="**NPI from 835 indicated organizational but is associated with an individual**" D EXPSET Q "RTN","RCDPEWLD",71,0) I $P(RCRTN,U,1)="Organization_ID" D Q "RTN","RCDPEWLD",72,0) . I $P(RCYNODE3,U,3)'=2 S RCEXP="**NPI from 835 indicated individual but is associated with an organization**" D EXPSET Q "RTN","RCDPEWLD",73,0) I $E($P(RCRTN,U,1),1,3)="Non" D Q "RTN","RCDPEWLD",74,0) . N RCIEN,RCTYPE S RCIEN=$P(RCRTN,U,2),RCTYPE=$$GET1^DIQ(355.93,RCIEN,.02,"I") Q:$G(RCTYPE)="" "RTN","RCDPEWLD",75,0) . I $P(RCYNODE3,U,3)=1,RCTYPE=1 S RCEXP="**NPI from 835 indicated individual but is associated with an organization**" D EXPSET Q "RTN","RCDPEWLD",76,0) . I $P(RCYNODE3,U,3)=2,RCTYPE=2 S RCEXP="**NPI from 835 indicated organizational but is associated with an individual**" D EXPSET Q "RTN","RCDPEWLD",77,0) I RCCOM2="",(+RCRTN=0) S RCEXP="**The NPI returned on the 835 is not associated with this VistA system**" D EXPSET Q "RTN","RCDPEWLD",78,0) Q "RTN","RCDPEWLD",79,0) ; "RTN","RCDPEWLD",80,0) EXPSET ;SET THE PRINT LINE WITH THE ERROR AS DEFINED IN RCEXP "RTN","RCDPEWLD",81,0) S $P(RCYYY(RCPROV),U,3)=RCEXP "RTN","RCDPEWLD",82,0) Q "RTN","RCDPEWLD",83,0) ; "RTN","RCDPEWLD",84,0) PARAMS(RCQUIT) ;PARAMETERS ENTRY CONTINUED FROM RCDPEWL0 "RTN","RCDPEWLD",85,0) I $G(RCQUIT) K ^TMP("RCERA_PARAMS",$J) "RTN","RCDPEWLD",86,0) PARMSQ ; "RTN","RCDPEWLD",87,0) Q "RTN","RCDPEWLD",88,0) ; "RTN","RCDPEWLD",89,0) PARAMS2() ;EP from RCDPEWL0 "RTN","RCDPEWLD",90,0) ; PRCA*4.5*317 - Moved due to routine size issues "RTN","RCDPEWLD",91,0) ; Input: None "RTN","RCDPEWLD",92,0) ; Returns: RCQUIT - 1 if user ^ or timed out, 0 otherwise "RTN","RCDPEWLD",93,0) S RCQUIT=$$PAYMNT() ; Ask for zero/payment PRCA*4.5*321 "RTN","RCDPEWLD",94,0) Q:RCQUIT 1 ; PRCA*4.5*321 "RTN","RCDPEWLD",95,0) S RCQUIT=$$POSTSTAT() ; Ask Posting Status "RTN","RCDPEWLD",96,0) Q:RCQUIT 1 "RTN","RCDPEWLD",97,0) S RCQUIT=$$POSTMETH ; Ask Posting Method "RTN","RCDPEWLD",98,0) Q:RCQUIT 1 "RTN","RCDPEWLD",99,0) S RCQUIT=$$MATCHST ; Ask ERA-EFT Matching Status "RTN","RCDPEWLD",100,0) Q:RCQUIT 1 "RTN","RCDPEWLD",101,0) S RCQUIT=$$CLAIMTYP() ; Ask Claim Type "RTN","RCDPEWLD",102,0) Q:RCQUIT 1 "RTN","RCDPEWLD",103,0) S RCQUIT=$$PAYR() ; Ask for selected payers "RTN","RCDPEWLD",104,0) Q RCQUIT "RTN","RCDPEWLD",105,0) ; "RTN","RCDPEWLD",106,0) PAYMNT() ; Payment Type (Zero/Payment or Both) Selection ; PRCA*4.5*321 this whole subroutine "RTN","RCDPEWLD",107,0) ; Input: ^TMP("RCERA_PARAMS") - Global array of preferred values (if any) "RTN","RCDPEWLD",108,0) ; Output: ^TMP("RCERA_PARAMS",$J,"RCPAYMNT") - ERA Posting Status filter "RTN","RCDPEWLD",109,0) ; Returns: 1 if user quit or timed out, 0 otherwise "RTN","RCDPEWLD",110,0) N DIR,DTOUT,DUOUT,RCTYPEDF "RTN","RCDPEWLD",111,0) S RCTYPEDF=$G(^TMP("RCERA_PARAMS",$J,"RCPAYMNT")) "RTN","RCDPEWLD",112,0) K DIR S DIR(0)="SA^Z:ZERO;P:PAYMENT;B:BOTH" "RTN","RCDPEWLD",113,0) S DIR("A")="(Z)ERO, (P)AYMENT, or (B)OTH: " "RTN","RCDPEWLD",114,0) S DIR("B")="B" "RTN","RCDPEWLD",115,0) S DIR("?",1)="Select ZERO to only see ERAs with a zero total amount paid." "RTN","RCDPEWLD",116,0) S DIR("?",2)="Select PAYMENT to only see ERAs with a non-zero amount paid." "RTN","RCDPEWLD",117,0) S DIR("?")="Select BOTH to see both zero and non-zero amount ERAs." "RTN","RCDPEWLD",118,0) S:RCTYPEDF'="" DIR("B")=RCTYPEDF ;Stored preferred value, use as default "RTN","RCDPEWLD",119,0) W ! "RTN","RCDPEWLD",120,0) D ^DIR "RTN","RCDPEWLD",121,0) I $D(DTOUT)!$D(DUOUT) Q 1 "RTN","RCDPEWLD",122,0) S ^TMP("RCERA_PARAMS",$J,"RCPAYMNT")=Y "RTN","RCDPEWLD",123,0) Q 0 "RTN","RCDPEWLD",124,0) ; "RTN","RCDPEWLD",125,0) POSTSTAT() ; ERA Posting Status (Posted/Unposted/Both) Selection "RTN","RCDPEWLD",126,0) ; Input: ^TMP("RCERA_PARAMS") - Global array of preferred values (if any) "RTN","RCDPEWLD",127,0) ; Output: ^TMP("RCERA_PARAMS",$J,"RCPOST")- ERA Posting Status filter "RTN","RCDPEWLD",128,0) ; Returns: 1 if user quit or timed out, 0 otherwise "RTN","RCDPEWLD",129,0) N DIR,DTOUT,DUOUT,RCPOSTDF "RTN","RCDPEWLD",130,0) S RCPOSTDF=$G(^TMP("RCERA_PARAMS",$J,"RCPOST")) "RTN","RCDPEWLD",131,0) K DIR S DIR(0)="SA^U:UNPOSTED;P:POSTED;B:BOTH" "RTN","RCDPEWLD",132,0) S DIR("A")="ERA posting status: (U)NPOSTED, (P)OSTED, or (B)OTH: " "RTN","RCDPEWLD",133,0) S DIR("B")="U" "RTN","RCDPEWLD",134,0) S DIR("?",1)="Select UNPOSTED to only see ERAs with a status of UNPOSTED." "RTN","RCDPEWLD",135,0) S DIR("?",2)="Select POSTED to only see ERAs with a status of POSTED." "RTN","RCDPEWLD",136,0) S DIR("?")="Select BOTH to see both unposted and posted ERAs." "RTN","RCDPEWLD",137,0) S:RCPOSTDF'="" DIR("B")=RCPOSTDF ; Stored preferred value, use as default "RTN","RCDPEWLD",138,0) W ! "RTN","RCDPEWLD",139,0) D ^DIR "RTN","RCDPEWLD",140,0) I $D(DTOUT)!$D(DUOUT) Q 1 "RTN","RCDPEWLD",141,0) S ^TMP("RCERA_PARAMS",$J,"RCPOST")=Y "RTN","RCDPEWLD",142,0) Q 0 "RTN","RCDPEWLD",143,0) ; "RTN","RCDPEWLD",144,0) POSTMETH() ; PRCA*4.5*317 moved from RCDPEWL0 because of routine size issues "RTN","RCDPEWLD",145,0) ; ERA Posting Method (Auto-Posting/Non Auto-Posting/Both) Selection "RTN","RCDPEWLD",146,0) ; Input: ^TMP("RCERA_PARAMS") - Global array of preferred values (if any) "RTN","RCDPEWLD",147,0) ; Output: ^TMP("RCERA_PARAMS",$J,"RCAUTOP")- ERA Posting Status filter "RTN","RCDPEWLD",148,0) ; Returns: 1 if user quit or timed out, 0 otherwise "RTN","RCDPEWLD",149,0) N DIR,DTOUT,DUOUT,RCAUTOPDF "RTN","RCDPEWLD",150,0) P1 S RCAUTOPDF=$G(^TMP("RCERA_PARAMS",$J,"RCAUTOP")) ; PRCA*4.5*326 "RTN","RCDPEWLD",151,0) K DIR S DIR(0)="SA^A:AUTO-POSTING;N:NON AUTO-POSTING;B:BOTH" "RTN","RCDPEWLD",152,0) S DIR("A")="Display (A)UTO-POSTING, (N)ON AUTO-POSTING, or (B)OTH: " "RTN","RCDPEWLD",153,0) S DIR("B")="B" "RTN","RCDPEWLD",154,0) S DIR("?",1)="Select AUTO-POSTING to only see auto-posted ERAs." "RTN","RCDPEWLD",155,0) S DIR("?",2)="Select NON AUTO-POSTING to only see ERAs that were NOT auto-posted." "RTN","RCDPEWLD",156,0) S DIR("?")="Select BOTH to see both auto-posted and non auto-posted ERAs." "RTN","RCDPEWLD",157,0) S:RCAUTOPDF'="" DIR("B")=RCAUTOPDF ;Stored preferred value, use as default "RTN","RCDPEWLD",158,0) W ! "RTN","RCDPEWLD",159,0) D ^DIR "RTN","RCDPEWLD",160,0) I $D(DTOUT)!$D(DUOUT) Q 1 "RTN","RCDPEWLD",161,0) G:'$$VALP(Y) P1 ; PRCA*4.5*326 "RTN","RCDPEWLD",162,0) S ^TMP("RCERA_PARAMS",$J,"RCAUTOP")=Y "RTN","RCDPEWLD",163,0) ; If including auto-post ERA ask for auto-post status filters "RTN","RCDPEWLD",164,0) I Y'="N" Q $$AUTOPST() ; PRCA*4.5*326 "RTN","RCDPEWLD",165,0) Q 0 "RTN","RCDPEWLD",166,0) ; "RTN","RCDPEWLD",167,0) MATCHST() ; ERA-EFT Matching Status(Matched/Unmatched/Both) Selection "RTN","RCDPEWLD",168,0) ; Input: ^TMP("RCERA_PARAMS") - Global array of preferred values (if any) "RTN","RCDPEWLD",169,0) ; Output: ^TMP("RCERA_PARAMS",$J,"RCMATCH")- ERA Posting Status filter "RTN","RCDPEWLD",170,0) ; Returns: 1 if user quit or timed out, 0 otherwise "RTN","RCDPEWLD",171,0) N DIR,DTOUT,DUOUT,RCMATCHD "RTN","RCDPEWLD",172,0) M1 S RCMATCHD=$G(^TMP("RCERA_PARAMS",$J,"RCMATCH")) ; PRCA*4.5*326 "RTN","RCDPEWLD",173,0) K DIR S DIR(0)="SA^N:NOT MATCHED;M:MATCHED;B:BOTH" "RTN","RCDPEWLD",174,0) S DIR("A")="ERA-EFT match status: (N)OT MATCHED, (M)ATCHED, or (B)OTH: " "RTN","RCDPEWLD",175,0) S DIR("B")="B" "RTN","RCDPEWLD",176,0) S DIR("?",1)="Select NOT MATCHED to only see unmatched ERAs." "RTN","RCDPEWLD",177,0) S DIR("?",2)="Select MATCHED to only see matched ERAs." "RTN","RCDPEWLD",178,0) S DIR("?")="Select BOTH to see both matched and unmatched ERAs." "RTN","RCDPEWLD",179,0) S:RCMATCHD'="" DIR("B")=RCMATCHD ;Stored preferred value, use as default "RTN","RCDPEWLD",180,0) W ! "RTN","RCDPEWLD",181,0) D ^DIR "RTN","RCDPEWLD",182,0) I $D(DTOUT)!$D(DUOUT) Q 1 "RTN","RCDPEWLD",183,0) G:'$$VALM(Y) M1 ; PRCA*4.5*326 "RTN","RCDPEWLD",184,0) S ^TMP("RCERA_PARAMS",$J,"RCMATCH")=Y "RTN","RCDPEWLD",185,0) Q 0 "RTN","RCDPEWLD",186,0) ; "RTN","RCDPEWLD",187,0) CLAIMTYP() ; Claim Type (Medical/Pharmacy/Both) Selection "RTN","RCDPEWLD",188,0) ; Input: ^TMP("RCERA_PARAMS") - Global array of preferred values (if any) "RTN","RCDPEWLD",189,0) ; Output: ^TMP("RCERA_PARAMS",$J,"RCTYPE") - ERA Posting Status filter "RTN","RCDPEWLD",190,0) ; Returns: 1 if user quit or timed out, 0 otherwise "RTN","RCDPEWLD",191,0) N DIR,DTOUT,DUOUT,RCTYPEDF "RTN","RCDPEWLD",192,0) S RCTYPEDF=$G(^TMP("RCERA_PARAMS",$J,"RCTYPE")) "RTN","RCDPEWLD",193,0) ; PRCA*4.5*321 - Changed set of codes and help "RTN","RCDPEWLD",194,0) K DIR S DIR(0)="SA^M:MEDICAL;P:PHARMACY;T:TRICARE;A:ALL" "RTN","RCDPEWLD",195,0) S DIR("A")="(M)EDICAL, (P)HARMACY, (T)RICARE or (A)LL: " "RTN","RCDPEWLD",196,0) S DIR("B")="A" "RTN","RCDPEWLD",197,0) S DIR("?",1)="Select MEDICAL to only see ERAs with a payer type of medical." "RTN","RCDPEWLD",198,0) S DIR("?",2)="Select PHARMACY to only see ERAs with a payer type of pharmacy." "RTN","RCDPEWLD",199,0) S DIR("?",3)="Select TRICARE to only see ERAs with a payer type of Tricare." "RTN","RCDPEWLD",200,0) S DIR("?")="Select ALL to see medical, pharmacy and Tricare ERAs." "RTN","RCDPEWLD",201,0) ; PRCA*4.5*321 - End modified code block "RTN","RCDPEWLD",202,0) S:RCTYPEDF'="" DIR("B")=RCTYPEDF ;Stored preferred value, use as default "RTN","RCDPEWLD",203,0) W ! "RTN","RCDPEWLD",204,0) D ^DIR "RTN","RCDPEWLD",205,0) I $D(DTOUT)!$D(DUOUT) Q 1 "RTN","RCDPEWLD",206,0) S ^TMP("RCERA_PARAMS",$J,"RCTYPE")=Y "RTN","RCDPEWLD",207,0) Q 0 "RTN","RCDPEWLD",208,0) ; "RTN","RCDPEWLD",209,0) PAYR() ; Payer Selection "RTN","RCDPEWLD",210,0) ; Input: ^TMP("RCERA_PARAMS",$J) - Global array of preferred values (if any) "RTN","RCDPEWLD",211,0) ; Output: ^TMP("RCERA_PARAMS",$J,"RCTYPE") - ERA Posting Status filter "RTN","RCDPEWLD",212,0) ; Returns: 1 if user quit or timed out, 0 otherwise "RTN","RCDPEWLD",213,0) N DIR,DTOUT,DUOUT,RCPAYR,RCPAYRDF,RCOUT,RCDONE "RTN","RCDPEWLD",214,0) S RCPAYRDF=$G(^TMP("RCERA_PARAMS",$J,"RCPAYR")) "RTN","RCDPEWLD",215,0) ; PRCA*4.5*332 - wrapped prompts in a for loop to allow the payer range prompt to return to inital prompt if "RTN","RCDPEWLD",216,0) ; user cancels out "RTN","RCDPEWLD",217,0) S (RCQUIT,RCDONE,RCOUT)=0 "RTN","RCDPEWLD",218,0) F Q:RCDONE D ; PRCA*4.5*332 - Remove GOTO and instead make FOR loop "RTN","RCDPEWLD",219,0) . K DIR S DIR(0)="SA^A:ALL;R:RANGE" "RTN","RCDPEWLD",220,0) . S DIR("A")="(A)LL payers, (R)ANGE of payer names: " "RTN","RCDPEWLD",221,0) . S DIR("B")="ALL" "RTN","RCDPEWLD",222,0) . S DIR("?",1)="Entering ALL will select all payers." "RTN","RCDPEWLD",223,0) . S DIR("?")="If RANGE is entered, you will be prompted for a payer range." "RTN","RCDPEWLD",224,0) . S:$P(RCPAYRDF,"^")'="" DIR("B")=$P(RCPAYRDF,"^",1) ;Stored preferred value, use as default "RTN","RCDPEWLD",225,0) . W ! "RTN","RCDPEWLD",226,0) . D ^DIR "RTN","RCDPEWLD",227,0) . I $D(DTOUT)!$D(DUOUT) S (RCDONE,RCOUT)=1 Q "RTN","RCDPEWLD",228,0) . S RCPAYR=Y "RTN","RCDPEWLD",229,0) . I RCPAYR="A" D Q "RTN","RCDPEWLD",230,0) . . S ^TMP("RCERA_PARAMS",$J,"RCPAYR")=Y ;All payers selected "RTN","RCDPEWLD",231,0) . . S RCDONE=1 "RTN","RCDPEWLD",232,0) . I RCPAYR="R" D "RTN","RCDPEWLD",233,0) . . W !,"Names you select here will be the payer names from the ERA, not the ins. file" "RTN","RCDPEWLD",234,0) . . K DIR "RTN","RCDPEWLD",235,0) . . S DIR("?")="Enter a name from 1 to 30 characters in UPPER CASE." "RTN","RCDPEWLD",236,0) . . S DIR(0)="FA^1:30^K:X'?.U X" "RTN","RCDPEWLD",237,0) . . S DIR("A")="Start with payer name: " "RTN","RCDPEWLD",238,0) . . S:$P(RCPAYRDF,"^",2)'="" DIR("B")=$P(RCPAYRDF,"^",2) ;Stored preferred value, use as default "RTN","RCDPEWLD",239,0) . . W ! "RTN","RCDPEWLD",240,0) . . D ^DIR "RTN","RCDPEWLD",241,0) . . I $D(DTOUT)!$D(DUOUT) D Q "RTN","RCDPEWLD",242,0) . . . K ^TMP("RCERA_PARAMS",$J,"RCPAYR") "RTN","RCDPEWLD",243,0) . . S RCPAYR("FROM")=Y "RTN","RCDPEWLD",244,0) . . K DIR "RTN","RCDPEWLD",245,0) . . S DIR("?")="Enter a name from 1 to 30 characters in UPPER CASE." "RTN","RCDPEWLD",246,0) . . S DIR(0)="FA^1:30^K:X'?.U X",DIR("A")="Go to payer name: " "RTN","RCDPEWLD",247,0) . . S DIR("B")=$E(RCPAYR("FROM"),1,27)_"ZZZ" "RTN","RCDPEWLD",248,0) . . S:$P(RCPAYRDF,"^",3)'="" DIR("B")=$P(RCPAYRDF,"^",3) ;Stored preferred value, use as default "RTN","RCDPEWLD",249,0) . . W ! "RTN","RCDPEWLD",250,0) . . D ^DIR "RTN","RCDPEWLD",251,0) . . I $D(DTOUT)!$D(DUOUT) Q "RTN","RCDPEWLD",252,0) . . S ^TMP("RCERA_PARAMS",$J,"RCPAYR")=RCPAYR_"^"_RCPAYR("FROM")_"^"_Y "RTN","RCDPEWLD",253,0) . . S RCDONE=1 "RTN","RCDPEWLD",254,0) Q RCOUT "RTN","RCDPEWLD",255,0) ; "RTN","RCDPEWLD",256,0) ; BEGIN PRCA*4.5*326 "RTN","RCDPEWLD",257,0) AUTOPST() ; Auto-post Status (Marked/Partial/Complete/All) Selection "RTN","RCDPEWLD",258,0) ; Input: ^TMP("RCERA_PARAMS") - Global array of preferred values (if any) "RTN","RCDPEWLD",259,0) ; Output: ^TMP("RCERA_PARAMS",$J,"RCAPSTA") - Auto-post Status filter "RTN","RCDPEWLD",260,0) ; Returns: 1 if user quit or timed out, 0 otherwise "RTN","RCDPEWLD",261,0) N DIR,DTOUT,DUOUT,APTYPEDF "RTN","RCDPEWLD",262,0) A1 S APTYPEDF=$G(^TMP("RCERA_PARAMS",$J,"RCAPSTA")) "RTN","RCDPEWLD",263,0) K DIR S DIR(0)="SA^M:MARKED;P:PARTIAL;C:COMPLETE;A:ALL" "RTN","RCDPEWLD",264,0) S DIR("A")="Auto-Post status: (M)ARKED, (P)ARTIAL, (C)OMPLETE or (A)LL: " "RTN","RCDPEWLD",265,0) S DIR("B")="A" "RTN","RCDPEWLD",266,0) S DIR("?",1)="Select MARKED to only see ERAs currently marked for autopost." "RTN","RCDPEWLD",267,0) S DIR("?",2)="Select PARTIAL to only see ERAs with a partial auto-post status." "RTN","RCDPEWLD",268,0) S DIR("?",3)="Select COMPLETE to only see ERAs with a complete auto-post status." "RTN","RCDPEWLD",269,0) S DIR("?")="Select ALL to see ERAs with any autopost status." "RTN","RCDPEWLD",270,0) S:APTYPEDF'="" DIR("B")=APTYPEDF ;Stored preferred value, use as default "RTN","RCDPEWLD",271,0) W ! "RTN","RCDPEWLD",272,0) D ^DIR "RTN","RCDPEWLD",273,0) I $D(DTOUT)!$D(DUOUT) Q 1 "RTN","RCDPEWLD",274,0) G:'$$VALA(Y) A1 "RTN","RCDPEWLD",275,0) S ^TMP("RCERA_PARAMS",$J,"RCAPSTA")=Y "RTN","RCDPEWLD",276,0) Q 0 "RTN","RCDPEWLD",277,0) ; "RTN","RCDPEWLD",278,0) VALA(INP) ; Compare input auto-post status filter to other filters "RTN","RCDPEWLD",279,0) ; Input INP - Y value from ^DIR "RTN","RCDPEWLD",280,0) ; Output 1 = Valid 0 = Invalid "RTN","RCDPEWLD",281,0) ; "RTN","RCDPEWLD",282,0) I INP="C",$G(^TMP("RCERA_PARAMS",$J,"RCPOST"))="U" D Q 0 "RTN","RCDPEWLD",283,0) .W !!,"Auto-post COMPLETE is an invalid selection for UNPOSTED ERAs" "RTN","RCDPEWLD",284,0) I INP="P",$G(^TMP("RCERA_PARAMS",$J,"RCPOST"))="U" D Q 0 "RTN","RCDPEWLD",285,0) .W !!,"Auto-post PARTIAL is an invalid selection for UNPOSTED ERAs" "RTN","RCDPEWLD",286,0) I INP="M",$G(^TMP("RCERA_PARAMS",$J,"RCPOST"))="P" D Q 0 "RTN","RCDPEWLD",287,0) .W !!,"MARKED for Auto-post is an invalid selection for POSTED ERAs" "RTN","RCDPEWLD",288,0) Q 1 "RTN","RCDPEWLD",289,0) ; "RTN","RCDPEWLD",290,0) VALM(INP) ; Compare input match type filter to other filters "RTN","RCDPEWLD",291,0) ; Input INP - Y value from ^DIR "RTN","RCDPEWLD",292,0) ; Output 1 = Valid 0 = Invalid "RTN","RCDPEWLD",293,0) ; "RTN","RCDPEWLD",294,0) I INP="N",$G(^TMP("RCERA_PARAMS",$J,"RCAUTOP"))="A" D Q 0 "RTN","RCDPEWLD",295,0) .W !!,"NOT MATCHED is an invalid selection for AUTO-POSTING ERAs" "RTN","RCDPEWLD",296,0) Q 1 "RTN","RCDPEWLD",297,0) ; "RTN","RCDPEWLD",298,0) VALP(INP) ; Compare input posting method filter to other filters "RTN","RCDPEWLD",299,0) ; Input INP - Y value from ^DIR "RTN","RCDPEWLD",300,0) ; Output 1 = Valid 0 = Invalid "RTN","RCDPEWLD",301,0) ; "RTN","RCDPEWLD",302,0) I INP="A",$G(^TMP("RCERA_PARAMS",$J,"RCPAYMNT"))="Z" D Q 0 "RTN","RCDPEWLD",303,0) .W !!,"AUTO-POSTING is an invalid selection for ZERO ERAs" "RTN","RCDPEWLD",304,0) Q 1 "RTN","RCDPEWLD",305,0) ; END PRCA*4.5*326 "RTN","RCDPEWLP") 0^23^B201114317 "RTN","RCDPEWLP",1,0) RCDPEWLP ;ALBANY/KML - EDI LOCKBOX ERA and EEOB WORKLIST procedures ;10 Oct 2018 11:49:24 "RTN","RCDPEWLP",2,0) ;;4.5;Accounts Receivable;**298,303,304,319,332**;Mar 20, 1995;Build 40 "RTN","RCDPEWLP",3,0) ;Per VA Directive 6402, this routine should not be modified. "RTN","RCDPEWLP",4,0) ; "RTN","RCDPEWLP",5,0) Q "RTN","RCDPEWLP",6,0) ; "RTN","RCDPEWLP",7,0) ; PRCA*4.5*298 - handle outstanding EFTs & ERAs with exceptions "RTN","RCDPEWLP",8,0) ; "RTN","RCDPEWLP",9,0) AGEDEFTS(ERADA,TYPE) ;function, Search medical or pharmacy aged EFTs that have not been posted "RTN","RCDPEWLP",10,0) ; ENTRY point for the Select ERA action on the ERA Worklist screen "RTN","RCDPEWLP",11,0) ; Input: ERADA - IEN in file 344.4 "RTN","RCDPEWLP",12,0) ; TYPE - Medical, Pharmacy or Tricare (M,P, T) "RTN","RCDPEWLP",13,0) ; Returns: "RTN","RCDPEWLP",14,0) ; "1P" Error for aged, unposted pharmacy EFTs "RTN","RCDPEWLP",15,0) ; "2P" Warning for aged,unposted pharmacy EFTs "RTN","RCDPEWLP",16,0) ; "3P" Override exists for aged, unposted pharmacy EFTs "RTN","RCDPEWLP",17,0) ; "1M" Error for aged, unposted medical EFTs "RTN","RCDPEWLP",18,0) ; "2M" Warning for aged, unposted medical EFTs "RTN","RCDPEWLP",19,0) ; "3M" Override exists for aged, unposted medical EFTs "RTN","RCDPEWLP",20,0) ; "1T" Error for aged, unposted Tricare EFTs "RTN","RCDPEWLP",21,0) ; "2T" Warning for aged, unposted Tricare EFTs "RTN","RCDPEWLP",22,0) ; "3T" Override exists for aged, unposted Tricare EFTs "RTN","RCDPEWLP",23,0) ; 0 No error or warning conditions "RTN","RCDPEWLP",24,0) ; NOTE: may be more than one - "1P" or "2P" or "3P" or "3P^2M" or "3P^3M", etc. "RTN","RCDPEWLP",25,0) ; "RTN","RCDPEWLP",26,0) ;for action Select ERA: "RTN","RCDPEWLP",27,0) ; 1. If unposted payments (EFTs) associated with 3rd party Medical claims > than 14 days, display WARNING message for action "RTN","RCDPEWLP",28,0) ; Select ERA on the ERA WORKLIST, allow user to enter the worklist "RTN","RCDPEWLP",29,0) ; 2. If there are unposted payments (EFTs) associated with Pharmacy claims > 21 days, display a WARNING message "RTN","RCDPEWLP",30,0) ; on the ERA WORKLIST, enter worklist "RTN","RCDPEWLP",31,0) ; 3. If there are unposted payments (EFTs) associated with 3rd party Tricare claims "RTN","RCDPEWLP",32,0) ; > 14 calendar days, display WARNING message, enter worklist "RTN","RCDPEWLP",33,0) ; 4. If there are unposted payments (EFTs) associated with 3rd party medical, pharmacy or "RTN","RCDPEWLP",34,0) ; Tricare claims, aged > the number of days in site parameters, display error message "RTN","RCDPEWLP",35,0) ;additional criteria for item 3: "RTN","RCDPEWLP",36,0) ;create scratchpad if: "RTN","RCDPEWLP",37,0) ; 3a. medical ERA is 14 days or older "RTN","RCDPEWLP",38,0) ; 3b. pharmacy ERA is 21 days or older "RTN","RCDPEWLP",39,0) ; 3c. Tricare ERA is 14 days or older "RTN","RCDPEWLP",40,0) ; 3d. If override exists "RTN","RCDPEWLP",41,0) ;DO NOT create scratchpad if no override and: "RTN","RCDPEWLP",42,0) ; 3e. medical ERA received within 14 days and there are aged, unposted EFTs "RTN","RCDPEWLP",43,0) ; 3f. pharmacy ERA received within 21 days and there are aged, unposted EFTs "RTN","RCDPEWLP",44,0) ; 3g. Tricare ERA received within 14 days and there are aged, unposted EFTs "RTN","RCDPEWLP",45,0) ; "RTN","RCDPEWLP",46,0) ;Do not consider EFTs older than two months prior to national release "RTN","RCDPEWLP",47,0) ;Note: EFTs to be auto-posted to a receipt included in search for aged, unposted EFTs "RTN","RCDPEWLP",48,0) N DATE,EFTDA,EFT0,RC3444,RC34431,SELERADT,UNPOST,X "RTN","RCDPEWLP",49,0) S UNPOST=0 "RTN","RCDPEWLP",50,0) S RC3444=^RCY(344.4,ERADA,0) "RTN","RCDPEWLP",51,0) I '$P(RC3444,U,5) G AEFTSQ ; skip ERAs with zero payment "RTN","RCDPEWLP",52,0) S EFTDA=+$O(^RCY(344.31,"AERA",ERADA,0)) "RTN","RCDPEWLP",53,0) S:EFTDA RC34431=^RCY(344.31,EFTDA,0) "RTN","RCDPEWLP",54,0) I 'EFTDA,$P(RC3444,U,9)=2 G AEFTSQ ; Ignore selected ERAs that are MATCHED TO PAPER CHECK "RTN","RCDPEWLP",55,0) ; "RTN","RCDPEWLP",56,0) ; skip unmatched ERAs with EXPECTED PAYMENT CODE "CHK" "RTN","RCDPEWLP",57,0) I 'EFTDA,$P(RC3444,U,15)="CHK" G AEFTSQ "RTN","RCDPEWLP",58,0) ; "RTN","RCDPEWLP",59,0) ; Use FILE DATE/TIME (344.4, .07) of ERA if no EFT (unmatched ERA), "RTN","RCDPEWLP",60,0) ; else use DATE RECEIVED (344.31,.13) of EFT associated with ERA "RTN","RCDPEWLP",61,0) S SELERADT=$S('EFTDA:$P($P(RC3444,U,7),"."),1:$P(RC34431,U,13)) "RTN","RCDPEWLP",62,0) ; "RTN","RCDPEWLP",63,0) I TYPE="P" D G AEFTSQ "RTN","RCDPEWLP",64,0) . I $$FMDIFF^XLFDT(DT,SELERADT)>21 S UNPOST=0 Q ;ERA older than 21 days, enter scratchpad "RTN","RCDPEWLP",65,0) . S UNPOST=$$GETEFTS(TYPE) ;NOT older than 21 days, get unposted, aged EFTs "RTN","RCDPEWLP",66,0) ; "RTN","RCDPEWLP",67,0) I TYPE="M" D G AEFTSQ "RTN","RCDPEWLP",68,0) . I $$FMDIFF^XLFDT(DT,SELERADT)>14 S UNPOST=0 Q ;ERA older than 14 days, enter scratchpad "RTN","RCDPEWLP",69,0) . S UNPOST=$$GETEFTS(TYPE) ;NOT older than 14 days, get unposted, aged EFTs "RTN","RCDPEWLP",70,0) ; "RTN","RCDPEWLP",71,0) I TYPE="T" D G AEFTSQ "RTN","RCDPEWLP",72,0) . I $$FMDIFF^XLFDT(DT,SELERADT)>14 S UNPOST=0 Q ;ERA older than 14 days, enter scratchpad "RTN","RCDPEWLP",73,0) . S UNPOST=$$GETEFTS(TYPE) ;NOT older than 14 days, get unposted, aged EFTs "RTN","RCDPEWLP",74,0) ; "RTN","RCDPEWLP",75,0) AEFTSQ ; single exit for function "RTN","RCDPEWLP",76,0) Q UNPOST "RTN","RCDPEWLP",77,0) ; "RTN","RCDPEWLP",78,0) GETEFTS(TYPE,OPTION) ;function, EP from RCDPEUPO for Unposted EFT Override option "RTN","RCDPEWLP",79,0) ; Set up search criteria for unposted EFTs. If aged, unposted EFTs create warning/prevention messages "RTN","RCDPEWLP",80,0) ; TYPE: "M" (Medical ERA-EFT), "P" (Phamacy ERA-EFT), "T" (Tricare ERA-EFT), "A" (Medical, Pharmacy & Tricare) "RTN","RCDPEWLP",81,0) ;OPTION: "RTN","RCDPEWLP",82,0) ; null if Called by Select ERA action on ERA Worklist "RTN","RCDPEWLP",83,0) ; 1 if Called by RCDPE UNPOSTED EFT OVERRIDE option "RTN","RCDPEWLP",84,0) ; Returns: See output for AGEDEFTS "RTN","RCDPEWLP",85,0) ; "RTN","RCDPEWLP",86,0) N ARRAY,DAYSLIMT,DTARRY,OUTCOME,OVERRIDE,STARTDT,STR,TRARRY,X "RTN","RCDPEWLP",87,0) S OPTION=$G(OPTION) "RTN","RCDPEWLP",88,0) I TYPE="A" D ; Retrieve all Aged Days limits "RTN","RCDPEWLP",89,0) . S DAYSLIMT("M")=$$GET1^DIQ(344.61,1,.06) ; Medical "RTN","RCDPEWLP",90,0) . S DAYSLIMT("P")=$$GET1^DIQ(344.61,1,.07) ; Pharmacy "RTN","RCDPEWLP",91,0) . S DAYSLIMT("T")=$$GET1^DIQ(344.61,1,.13) ; Tricare "RTN","RCDPEWLP",92,0) ; Retrieve Aged Days limit for specified type "RTN","RCDPEWLP",93,0) I '(TYPE="A") S DAYSLIMT(TYPE)=$$GET1^DIQ(344.61,1,$S(TYPE="M":.06,TYPE="P":.07,1:.13)) "RTN","RCDPEWLP",94,0) S STARTDT=$$CUTOFF "RTN","RCDPEWLP",95,0) D EFTDET(STARTDT,TYPE,.DAYSLIMT,.TRARRY) "RTN","RCDPEWLP",96,0) ; "RTN","RCDPEWLP",97,0) ; Aged unposted EFTs exist. Create prevention message and if called within "RTN","RCDPEWLP",98,0) ; the Worklist (not Override option) plus msg. with list of TRACE #s "RTN","RCDPEWLP",99,0) F X="M","P","T" D "RTN","RCDPEWLP",100,0) . I $D(TRARRY("ERROR",X)) D "RTN","RCDPEWLP",101,0) .. D CHECK^RCDPEUPO(X,.OVERRIDE) ; Determine if Override exists "RTN","RCDPEWLP",102,0) .. I OVERRIDE S OUTCOME=$G(OUTCOME)_3_X_U Q "RTN","RCDPEWLP",103,0) .. S OUTCOME=$G(OUTCOME)_1_X_U "RTN","RCDPEWLP",104,0) .. ; do not display warning msg if error condition exists "RTN","RCDPEWLP",105,0) .. K TRARRY("WARNING",X) "RTN","RCDPEWLP",106,0) .. Q:OPTION Q:OVERRIDE "RTN","RCDPEWLP",107,0) .. Q:(TYPE'="A"&(TYPE'=X)) ; Only show error messages for TYPE "RTN","RCDPEWLP",108,0) .. M ARRAY=TRARRY("ERROR",X) "RTN","RCDPEWLP",109,0) .. D FTRACE(.ARRAY,.STR),PREVMSG(X,.DAYSLIMT,.STR) "RTN","RCDPEWLP",110,0) .. K ARRAY "RTN","RCDPEWLP",111,0) ; "RTN","RCDPEWLP",112,0) F X="M","P","T" D "RTN","RCDPEWLP",113,0) . I $D(TRARRY("WARNING",X)) D "RTN","RCDPEWLP",114,0) .. S OUTCOME=$G(OUTCOME)_2_X_U "RTN","RCDPEWLP",115,0) .. Q:OPTION ; Called by OVERRIDE option, no trace number list "RTN","RCDPEWLP",116,0) .. Q:(TYPE'="A"&(TYPE'=X)) ; Only show warning messages for TYPE "RTN","RCDPEWLP",117,0) .. M ARRAY=TRARRY("WARNING",X) "RTN","RCDPEWLP",118,0) .. D FTRACE(.ARRAY,.STR),WARNMSG(X,.STR) "RTN","RCDPEWLP",119,0) .. K ARRAY ; aged unposted EFTs > 21 days exist, generate warning message "RTN","RCDPEWLP",120,0) ; "RTN","RCDPEWLP",121,0) S:'$D(OUTCOME) OUTCOME=0 ; no error or warnings "RTN","RCDPEWLP",122,0) ; "RTN","RCDPEWLP",123,0) Q OUTCOME "RTN","RCDPEWLP",124,0) ; "RTN","RCDPEWLP",125,0) CUTOFF() ; Returns EFT Cutoff date "RTN","RCDPEWLP",126,0) ; date is 2 months prior to install date of patch 298, ignore aged EFTS older than that "RTN","RCDPEWLP",127,0) N RCX S RCX=+$P($G(^RCY(344.61,1,0)),U,9) "RTN","RCDPEWLP",128,0) S:RCX=0 RCX=DT "RTN","RCDPEWLP",129,0) Q $$FMADD^XLFDT(RCX,-61,0,0) "RTN","RCDPEWLP",130,0) ; "RTN","RCDPEWLP",131,0) EFTDET(RECVDT,TYPE,DAYSLIMT,TRARRY) ; Gather EFT data, Only EFTs that are aged and unposted "RTN","RCDPEWLP",132,0) ;Input: "RTN","RCDPEWLP",133,0) ; RECVDT - start date in DATE RECEIVED cross-reference of file 344.3 "RTN","RCDPEWLP",134,0) ; TYPE- "M" - (Medical ERA-EFT), "P" (Phamacy ERA-EFT), "T" (TRICARE ERA-EFT), "A" (Medical, Pharmacy and Tricare) "RTN","RCDPEWLP",135,0) ; DAYSLIMT - days EFT can age before post prevention rules apply "RTN","RCDPEWLP",136,0) ;Output: "RTN","RCDPEWLP",137,0) ; TRARRY - Array of trace numbers of the aged, unposted EFTs "RTN","RCDPEWLP",138,0) ; "RTN","RCDPEWLP",139,0) N EFTDA "RTN","RCDPEWLP",140,0) F S RECVDT=$O(^RCY(344.31,"ADR",RECVDT)) Q:'RECVDT D "RTN","RCDPEWLP",141,0) . S EFTDA="" F S EFTDA=$O(^RCY(344.31,"ADR",RECVDT,EFTDA)) Q:'EFTDA D "RTN","RCDPEWLP",142,0) .. D CHKEFT(RECVDT,EFTDA,TYPE,.DAYSLIMT,.TRARRY) "RTN","RCDPEWLP",143,0) Q "RTN","RCDPEWLP",144,0) ; "RTN","RCDPEWLP",145,0) CHKEFT(RECVDT,EFTDA,TYPE,DAYSLIMT,TRARRY) ; Check EFT for warnings/errors "RTN","RCDPEWLP",146,0) ;Input: "RTN","RCDPEWLP",147,0) ; RECVDT - Date Received "RTN","RCDPEWLP",148,0) ; EFTDA - IEN of EDI THIRD PARY EFT DETAIL "RTN","RCDPEWLP",149,0) ; TYPE - "M" (Medical ERA-EFT), "P" (Phamacy ERA-EFT), "T"(Tricare ERA-EFT), "A" (Medical, Pharmacy and Tricare) "RTN","RCDPEWLP",150,0) ; DAYSLIMT - days an EFT can age before post prevention rules apply "RTN","RCDPEWLP",151,0) ; TRARRY - Array with warning error info "RTN","RCDPEWLP",152,0) ; "RTN","RCDPEWLP",153,0) N AGED,EFTTYPE,ERAREC,MSTATUS,TRACE "RTN","RCDPEWLP",154,0) Q:$G(^RCY(344.31,EFTDA,0))="" ; skip, no data "RTN","RCDPEWLP",155,0) Q:+$$GET1^DIQ(344.31,EFTDA_",",.07,"I")=0 ; skip, zero payment amt. "RTN","RCDPEWLP",156,0) ; "RTN","RCDPEWLP",157,0) ; Ignore duplicate EFTs which have been removed "RTN","RCDPEWLP",158,0) Q:$$GET1^DIQ(344.31,EFTDA_",",.18,"I") ;^DD(344.31,.18,0)="DATE/TIME DUPLICATE REMOVED "RTN","RCDPEWLP",159,0) S ERAREC=+$$GET1^DIQ(344.31,EFTDA_",",.1,"I") ; Pointer to ERA record "RTN","RCDPEWLP",160,0) I ERAREC,$$GET1^DIQ(344.4,ERAREC_",",.14,"I")=1 Q ; Ignore posted ERA-EFTs "RTN","RCDPEWLP",161,0) ; "RTN","RCDPEWLP",162,0) ; Exclude EFT matched to Paper EOB if receipt is processed "RTN","RCDPEWLP",163,0) I 'ERAREC,$$GET1^DIQ(344.31,EFTDA_",",.08,"I") Q:$$PROC(EFTDA) "RTN","RCDPEWLP",164,0) S MSTATUS=+$$GET1^DIQ(344.31,EFTDA_",",.08,"I") ; MATCH STATUS "RTN","RCDPEWLP",165,0) S AGED=$$FMDIFF^XLFDT(DT,RECVDT) ; days aged for EFT "RTN","RCDPEWLP",166,0) S TRACE=$$GET1^DIQ(344.31,EFTDA_",",.04,"I") ; TRACE # "RTN","RCDPEWLP",167,0) S:TRACE="" TRACE="(No trace #)" "RTN","RCDPEWLP",168,0) ; no ERA, cannot evaluate further "RTN","RCDPEWLP",169,0) I 'ERAREC D Q ; "RTN","RCDPEWLP",170,0) . S EFTTYPE=$S($$ISTYPE^RCDPEU1(344.31,EFTDA,"P"):"P",$$ISTYPE^RCDPEU1(344.31,EFTDA,"T"):"T",1:"M") "RTN","RCDPEWLP",171,0) . S TRARRY("WARNING",EFTTYPE,TRACE)="No ERA found"_U_MSTATUS "RTN","RCDPEWLP",172,0) ; "RTN","RCDPEWLP",173,0) I (TYPE="A")!(TYPE="P"),$$PHARM(ERAREC) D Q "RTN","RCDPEWLP",174,0) . ; Aged, unposted EFT gets error message, no scratchpad for the ERA "RTN","RCDPEWLP",175,0) . I AGED>DAYSLIMT("P") S TRARRY("ERROR","P",TRACE)="ERA = "_ERAREC_U_MSTATUS Q "RTN","RCDPEWLP",176,0) . ; Aged, unposted PHARMACY EFT display warning message when entering scratchpad with the ERA "RTN","RCDPEWLP",177,0) . I '$D(TRARRY("ERROR")),AGED>21 S TRARRY("WARNING","P",TRACE)="ERA = "_ERAREC_U_MSTATUS "RTN","RCDPEWLP",178,0) ; "RTN","RCDPEWLP",179,0) I (TYPE="A")!(TYPE="T"),$$ISTYPE^RCDPEU1(344.31,EFTDA,"T") D Q ; is payer type Tricare? "RTN","RCDPEWLP",180,0) . ; Aged, unposted EFT gets error message, no scratchpad for the ERA "RTN","RCDPEWLP",181,0) . I AGED>DAYSLIMT("T") S TRARRY("ERROR","T",TRACE)="ERA = "_ERAREC_U_MSTATUS Q "RTN","RCDPEWLP",182,0) . ; Aged, unposted MEDICAL EFT display warning message when entering scratchpad with the ERA "RTN","RCDPEWLP",183,0) . I '$D(TRARRY("ERROR")),AGED>14 S TRARRY("WARNING","T",TRACE)="ERA = "_ERAREC_U_MSTATUS "RTN","RCDPEWLP",184,0) ; "RTN","RCDPEWLP",185,0) I (TYPE="A")!(TYPE="M"),'$$PHARM(ERAREC) D "RTN","RCDPEWLP",186,0) . I AGED>DAYSLIMT("M") S TRARRY("ERROR","M",TRACE)="ERA = "_ERAREC_U_MSTATUS Q "RTN","RCDPEWLP",187,0) . ; Aged, unposted MEDICAL EFT warning message when entering scratchpad with ERA "RTN","RCDPEWLP",188,0) . I '$D(TRARRY("ERROR")),AGED>14 S TRARRY("WARNING","M",TRACE)="ERA = "_ERAREC_U_MSTATUS "RTN","RCDPEWLP",189,0) ; "RTN","RCDPEWLP",190,0) Q "RTN","RCDPEWLP",191,0) ; "RTN","RCDPEWLP",192,0) PROC(EFTDA) ; Check if TR Receipt for an EFT linked to Paper EOB is processed "RTN","RCDPEWLP",193,0) ; Input: EFTDA - IEN for file 344.31 "RTN","RCDPEWLP",194,0) ; Returns: 1 if TR receipt exists and is OPEN, 0 otherwise "RTN","RCDPEWLP",195,0) N IEN344,RET S RET=0 "RTN","RCDPEWLP",196,0) ; Find TR receipt and check if status is not CLOSED "RTN","RCDPEWLP",197,0) S IEN344=$O(^RCY(344,"AEFT",EFTDA,0)) "RTN","RCDPEWLP",198,0) I IEN344,$$GET1^DIQ(344,IEN344_",",.14,"I")'=1 S RET=1 "RTN","RCDPEWLP",199,0) Q RET "RTN","RCDPEWLP",200,0) ; "RTN","RCDPEWLP",201,0) FTRACE(TRARRY,STR) ; both args. passed by ref. "RTN","RCDPEWLP",202,0) ; TRARRY - trace numbers of aged, unposted EFTs "RTN","RCDPEWLP",203,0) ; returns: STR - array of trace numbers separated by commas for warning or error message "RTN","RCDPEWLP",204,0) N CTR,LEN,TRACE,X "RTN","RCDPEWLP",205,0) K STR S CTR=1,TRACE="" "RTN","RCDPEWLP",206,0) F S TRACE=$O(TRARRY(TRACE)) Q:TRACE="" D "RTN","RCDPEWLP",207,0) . S STR(CTR)=$G(STR(CTR)) ; Initialize "RTN","RCDPEWLP",208,0) . I $L(STR(CTR))+$L(TRACE)>77 S CTR=CTR+1,STR(CTR)=TRACE Q "RTN","RCDPEWLP",209,0) . S STR(CTR)=STR(CTR)_$S(STR(CTR)]"":",",1:"")_TRACE ; comma if needed "RTN","RCDPEWLP",210,0) Q "RTN","RCDPEWLP",211,0) ; "RTN","RCDPEWLP",212,0) WARNMSG(TYPE,STR) ; warning message when aged, unposted EFTs exist "RTN","RCDPEWLP",213,0) ; Input: TYPE - "M" - Medical, "P" - Pharmacy or "T" - Tricare "RTN","RCDPEWLP",214,0) ; STR - Array, subscripts are strings in "trace#, trace#," format "RTN","RCDPEWLP",215,0) N DIR,LN,X,Y "RTN","RCDPEWLP",216,0) S DIR(0)="EA" "RTN","RCDPEWLP",217,0) S DIR("A",1)="WARNING: Unposted "_$S(TYPE="P":"pharmacy",TYPE="M":"medical",1:"TRICARE") "RTN","RCDPEWLP",218,0) S DIR("A",1)=DIR("A",1)_" EFTs exist that are more than "_$S(TYPE="P":21,1:14)_" days old." "RTN","RCDPEWLP",219,0) S DIR("A",2)=" " "RTN","RCDPEWLP",220,0) S DIR("A",3)="Post the older payments first. The EFTs may be unmatched or matched." "RTN","RCDPEWLP",221,0) S DIR("A",4)="Trace number(s) associated with unposted EFTs:" "RTN","RCDPEWLP",222,0) S LN=4,X=0 F S X=$O(STR(X)) Q:'X S LN=LN+1,DIR("A",LN)=STR(X) "RTN","RCDPEWLP",223,0) S LN=LN+1,DIR("A",LN)=" " "RTN","RCDPEWLP",224,0) S DIR("A")="Press ENTER to continue: " "RTN","RCDPEWLP",225,0) W ! "RTN","RCDPEWLP",226,0) D ^DIR "RTN","RCDPEWLP",227,0) Q "RTN","RCDPEWLP",228,0) ; "RTN","RCDPEWLP",229,0) PREVMSG(TYPE,DAYS,STR) ; Display Error message when aged, unposted EFTs exist "RTN","RCDPEWLP",230,0) ;Input: "RTN","RCDPEWLP",231,0) ; TYPE - "M":Medical, "P":Pharmacy, "T":Tricare "RTN","RCDPEWLP",232,0) ; DAYS - days EFT can age before post prevention rules apply "RTN","RCDPEWLP",233,0) ; STR - Array, each subscrpt is string of trace numbers in "trace#, trace#," format "RTN","RCDPEWLP",234,0) ; "RTN","RCDPEWLP",235,0) N DIR,LN,X,Y "RTN","RCDPEWLP",236,0) S DIR(0)="EA" "RTN","RCDPEWLP",237,0) S DIR("A",1)="ERROR: Unposted "_$S(TYPE="P":"Pharmacy",TYPE="M":"Medical",1:"TRICARE") "RTN","RCDPEWLP",238,0) S DIR("A",1)=DIR("A",1)_" EFTs exist that are more than "_DAYS(TYPE)_" days old. Scratchpad" "RTN","RCDPEWLP",239,0) S DIR("A",2)="creation is not allowed for newer payments. Post older payments first." "RTN","RCDPEWLP",240,0) S DIR("A",3)="The EFTs may be matched or unmatched." "RTN","RCDPEWLP",241,0) S DIR("A",4)=" " "RTN","RCDPEWLP",242,0) S DIR("A",5)="Trace number(s) associated with unposted EFTs:" "RTN","RCDPEWLP",243,0) S LN=5,X=0 F S X=$O(STR(X)) Q:'X S LN=LN+1,DIR("A",LN)=" "_STR(X) "RTN","RCDPEWLP",244,0) S LN=LN+1,DIR("A",LN)=" " "RTN","RCDPEWLP",245,0) S DIR("A")="Press ENTER to continue: " "RTN","RCDPEWLP",246,0) W ! "RTN","RCDPEWLP",247,0) D ^DIR "RTN","RCDPEWLP",248,0) Q "RTN","RCDPEWLP",249,0) ; "RTN","RCDPEWLP",250,0) EXCDENY ; PRCA*4.5*298 "RTN","RCDPEWLP",251,0) ; access denied message for ERAs selected off ERA Worklist with exceptions "RTN","RCDPEWLP",252,0) ; PRCA*4.5*304 - undeclared parameters (from WL^RCDPEWL7): RCERA and RCEXC "RTN","RCDPEWLP",253,0) N DIR,DIROUT,DIRUT,DTOUT,DUOUT,RCDWLIEN,X,Y "RTN","RCDPEWLP",254,0) S DIR(0)="YA" "RTN","RCDPEWLP",255,0) S DIR("A",1)="ACCESS DENIED: Scratchpad creation is not allowed when third party" "RTN","RCDPEWLP",256,0) S DIR("A",2)="medical exceptions exist. Fix Transmission Exceptions first and then Data" "RTN","RCDPEWLP",257,0) S DIR("A",3)="Exceptions with the EXE EDI Lockbox 3rd Party Exceptions option which is" "RTN","RCDPEWLP",258,0) S DIR("A",4)="located on the EDI Lockbox Main Menu." "RTN","RCDPEWLP",259,0) S DIR("A",5)=" " "RTN","RCDPEWLP",260,0) ;PRCA*4.5*304 - Allow user to fix exceptions "RTN","RCDPEWLP",261,0) S DIR("A")="Do you want to begin clearing Exceptions for this ERA (Y/N)?: " "RTN","RCDPEWLP",262,0) S DIR("B")="Y" "RTN","RCDPEWLP",263,0) W ! D ^DIR "RTN","RCDPEWLP",264,0) ;PRCA*4.5*304 - allow jump to work on Exceptions "RTN","RCDPEWLP",265,0) ; If 'yes' to work on exceptions?, set neeeded vars., default payer range is ALL (for now) "RTN","RCDPEWLP",266,0) I Y=1 D S:$G(RCMBG)'="" VALMBG=RCMBG S:$G(RCDWLIEN)'="" RCERA=RCDWLIEN S RCEXC=1 K RCMBG "RTN","RCDPEWLP",267,0) . S RCMBG=$G(VALMBG),RCDWLIEN=RCERA D EN^RCDPEX1 "RTN","RCDPEWLP",268,0) Q "RTN","RCDPEWLP",269,0) ; "RTN","RCDPEWLP",270,0) EXCWARN(ERADA) ; prca*4.5*298 warning msg. if exception "RTN","RCDPEWLP",271,0) ; Input: ERADA - IEN in file 344.4 "RTN","RCDPEWLP",272,0) ; Output: WARNING MESSAGE if exception exists on ERA "RTN","RCDPEWLP",273,0) ; "RTN","RCDPEWLP",274,0) Q:$$PHARM(ERADA) ; Ignore pharmacy ERA "RTN","RCDPEWLP",275,0) Q:$$XCEPT(ERADA)="" ; no exception "RTN","RCDPEWLP",276,0) N DIR "RTN","RCDPEWLP",277,0) S DIR(0)="EA" "RTN","RCDPEWLP",278,0) S DIR("A",1)="WARNING: Fix Transmission Exceptions first and then Data Exceptions via" "RTN","RCDPEWLP",279,0) S DIR("A",2)="the EXE EDI Lockbox 3rd Party Exceptions option which is located on the" "RTN","RCDPEWLP",280,0) S DIR("A",3)="EDI Lockbox Main Menu." "RTN","RCDPEWLP",281,0) S DIR("A",4)=" " "RTN","RCDPEWLP",282,0) S DIR("A")="Press ENTER to continue: " "RTN","RCDPEWLP",283,0) W ! "RTN","RCDPEWLP",284,0) D ^DIR "RTN","RCDPEWLP",285,0) Q "RTN","RCDPEWLP",286,0) ; "RTN","RCDPEWLP",287,0) XCEPT(ERADA) ; prca*4.5*298, return ERA exception state "RTN","RCDPEWLP",288,0) ; Input: ERADA - IEN in file 344.4 "RTN","RCDPEWLP",289,0) ; Returns: "x" or null, "x": Exception for a claim in the ERA "RTN","RCDPEWLP",290,0) N RES "RTN","RCDPEWLP",291,0) S RES=$S($D(^RCY(344.4,"AEXC",1,ERADA)):"x",$D(^RCY(344.4,"AEXC",2,ERADA)):"x",$D(^RCY(344.4,"AEXC",99,ERADA)):"ERADA",1:"") "RTN","RCDPEWLP",292,0) Q RES "RTN","RCDPEWLP",293,0) ; "RTN","RCDPEWLP",294,0) PHARM(X1) ; prca*4.5*298, function, Pharmacy, or Medical ERA? "RTN","RCDPEWLP",295,0) ; X1 - IEN file 344.4 "RTN","RCDPEWLP",296,0) ; Returns: 1: Pharmacy ERA, 0: Non-pharmacy ERA "RTN","RCDPEWLP",297,0) Q $S($D(^RCY(344.4,X1,1,"ECME")):1,1:0) "RTN","RCDPEWLP",298,0) ; "RTN","RCDPEWLP",299,0) GETPHARM(PRCAIEN,RCARRY) ;prca*4.5*298 return pharmacy data to show on EEOB items in scratchpad "RTN","RCDPEWLP",300,0) ; Input: PRCAIEN - IEN file 430 "RTN","RCDPEWLP",301,0) ; Output: RCARRY - holds pharmacy data "RTN","RCDPEWLP",302,0) ; IA 6033 - read access file 362.4 "RTN","RCDPEWLP",303,0) ; ICR 1878 - EN^PSOORDER call "RTN","RCDPEWLP",304,0) N RC0,RCDFN,RXDATA,RXFILL,RXIEN "RTN","RCDPEWLP",305,0) K RCARRY "RTN","RCDPEWLP",306,0) Q:PRCAIEN="" "RTN","RCDPEWLP",307,0) S RCDFN=$P(^PRCA(430,PRCAIEN,0),U,7) "RTN","RCDPEWLP",308,0) S RC0=+$O(^IBA(362.4,"C",PRCAIEN,0)) Q:RC0=0 "RTN","RCDPEWLP",309,0) S RXDATA=$G(^IBA(362.4,RC0,0)) "RTN","RCDPEWLP",310,0) S RCARRY("DOS")=$$FMTE^XLFDT($P(RXDATA,U,3),"2Z") "RTN","RCDPEWLP",311,0) S RCARRY("FILL")=+$P(RXDATA,U,10) ; Rx fill# "RTN","RCDPEWLP",312,0) S RXIEN=+$P(RXDATA,U,5) ; Rx IEN in file 52 "RTN","RCDPEWLP",313,0) D EN^PSOORDER(RCDFN,RXIEN) "RTN","RCDPEWLP",314,0) S RCARRY("RX")=$P(^TMP("PSOR",$J,RXIEN,0),U,5) "RTN","RCDPEWLP",315,0) I RCARRY("FILL")=0 D "RTN","RCDPEWLP",316,0) . S RCARRY("RELEASED STATUS")=$S($P(^TMP("PSOR",$J,RXIEN,0),U,13)]"":"Released",1:"Not Released") ; determine release status from Rx on the first fill (no refills) "RTN","RCDPEWLP",317,0) I RCARRY("FILL")>0 D "RTN","RCDPEWLP",318,0) . S RCARRY("RELEASED STATUS")=$S($P($G(^TMP("PSOR",$J,RXIEN,"REF",RCARRY("FILL"),0)),U,8)]"":"Released",1:"Not Released") ; ; determine release status from Rx refill # ;PRCA319 add $G() "RTN","RCDPEWLP",319,0) Q "RTN","RCDPEWLP",320,0) ; "RTN","RCDPEWLP",321,0) CV ; Change View action for ERA Worklist "RTN","RCDPEWLP",322,0) D FULL^VALM1 "RTN","RCDPEWLP",323,0) D PARAMS^RCDPEWL0("CV") "RTN","RCDPEWLP",324,0) D HDR^RCDPEWL7,INIT^RCDPEWL7 "RTN","RCDPEWLP",325,0) S VALMBCK="R",VALMBG=1 "RTN","RCDPEWLP",326,0) Q "RTN","RCDPEWLP",327,0) ; "RTN","RCDPEWLP",328,0) NOEDIT ; no edit allowed, ERA designated for auto-posting "RTN","RCDPEWLP",329,0) N DIR "RTN","RCDPEWLP",330,0) S DIR(0)="EA",DIR("A",1)="This action is not available for Auto-Posted ERAs." "RTN","RCDPEWLP",331,0) S DIR("A")="Press ENTER to continue: " "RTN","RCDPEWLP",332,0) W ! D ^DIR W ! "RTN","RCDPEWLP",333,0) Q "RTN","RCDPEWLP",334,0) ; "RTN","RCDPEWLP",335,0) VR(ERADA) ; handle auto-posted ERAs, Look at Receipt protocol for standard Worklist "RTN","RCDPEWLP",336,0) ; Input: ERADA - IEN from file 344.49 (and 344.4) "RTN","RCDPEWLP",337,0) N RCDA,RCZ,RCZ0,EEOBREC "RTN","RCDPEWLP",338,0) D SEL^RCDPEWL(.RCDA) ; Select EEOB off scratchpad "RTN","RCDPEWLP",339,0) S RCZ=+$O(RCDA(0)),RCZ=+$G(RCDA(RCZ)) "RTN","RCDPEWLP",340,0) Q:'RCZ "RTN","RCDPEWLP",341,0) S RCZ0=$G(^RCY(344.49,ERADA,1,RCZ,0)) "RTN","RCDPEWLP",342,0) S EEOBREC=$P($G(^RCY(344.4,ERADA,1,+$P(RCZ0,U,9),4)),U,3) "RTN","RCDPEWLP",343,0) I EEOBREC']"" D NOVIEW Q "RTN","RCDPEWLP",344,0) D EN^VALM("RCDPE AUTO EOB RECEIPT PREVIEW") "RTN","RCDPEWLP",345,0) Q "RTN","RCDPEWLP",346,0) ; "RTN","RCDPEWLP",347,0) NOVIEW ; selected EEOB cannot be viewed if no receipt number "RTN","RCDPEWLP",348,0) N DIR "RTN","RCDPEWLP",349,0) S DIR(0)="EA" "RTN","RCDPEWLP",350,0) S DIR("A",1)="THIS ACTION IS NOT AVAILABLE SINCE THE EEOB HAS NOT BEEN AUTO-POSTED." "RTN","RCDPEWLP",351,0) S DIR("A")="Press ENTER to continue: " "RTN","RCDPEWLP",352,0) W ! D ^DIR W ! "RTN","RCDPEWLP",353,0) Q "RTN","RCDPEWLP",354,0) ; "RTN","RCDPEWLP",355,0) INIT(ERADA,EEOBREC) ; List Template - RCDPE AUTO EOB RECEIPT PREVIEW entry point "RTN","RCDPEWLP",356,0) ; Display EEOBs that have been posted (receipt exists) "RTN","RCDPEWLP",357,0) ; Input: "RTN","RCDPEWLP",358,0) ; ERADA - IEN file 344.49 (and 344.4) "RTN","RCDPEWLP",359,0) ; EEOBREC - Selected EEOBs receipt "RTN","RCDPEWLP",360,0) ; Output: ^TMP("RCDPE_AP_EOB_PREVIEW",$J) "RTN","RCDPEWLP",361,0) N RCPT,RCZ,Z,Z0,Z1,Z2,SEQ "RTN","RCDPEWLP",362,0) K ^TMP("RCDPE_AP_EOB_PREVIEW",$J) "RTN","RCDPEWLP",363,0) S VALMCNT=0,VALMBG=1 "RTN","RCDPEWLP",364,0) S SEQ(344.491)=0 F S SEQ(344.491)=$O(^RCY(344.49,ERADA,1,SEQ(344.491))) Q:'SEQ(344.491) D "RTN","RCDPEWLP",365,0) . S SEQ(344.491,0)=$G(^RCY(344.49,ERADA,1,SEQ(344.491),0)) "RTN","RCDPEWLP",366,0) . I $P(SEQ(344.491,0),U)\1=+SEQ(344.491,0) S SEQ("claim#")=$P(SEQ(344.491,0),U,2) "RTN","RCDPEWLP",367,0) . S RCPT=+$P($G(^RCY(344.4,ERADA,1,+$P(SEQ(344.491,0),U,9),4)),U,3),RCPT(RCPT)="" ; receipt array "RTN","RCDPEWLP",368,0) . I $P($P(SEQ(344.491,0),U),".",2),$D(RCPT(EEOBREC)) D ; if the EEOB has same receipt# as selected EEOB it can be on the preview screen "RTN","RCDPEWLP",369,0) .. S:$P(SEQ(344.491,0),U,2)="" $P(SEQ(344.491,0),U,2)=SEQ("claim#") "RTN","RCDPEWLP",370,0) .. ;RCZ=0:zero payments, -1:negative bal., 1:lines for rcpt., 2:other lines "RTN","RCDPEWLP",371,0) .. S RCZ=$S(+$P(SEQ(344.491,0),U,6)=0:0,+$P(SEQ(344.491,0),U,6)<0:-1,$P(SEQ(344.491,0),U,7):1,1:2) "RTN","RCDPEWLP",372,0) .. S RCZ(RCZ,SEQ(344.491))=SEQ(344.491,0) "RTN","RCDPEWLP",373,0) .. K RCPT "RTN","RCDPEWLP",374,0) .. S SEQ(344.4911)=0 F S SEQ(344.4911)=$O(^RCY(344.49,ERADA,1,SEQ(344.491),1,SEQ(344.4911))) Q:'SEQ(344.4911) D "RTN","RCDPEWLP",375,0) ... S SEQ(344.4911,0)=$G(^RCY(344.49,ERADA,1,SEQ(344.491),1,SEQ(344.4911),0)) "RTN","RCDPEWLP",376,0) ... I $P(SEQ(344.4911,0),U,5)=1 D ;(#.05) BACKGROUND ACTION [5S] - '1' FOR DECREASE ADJUSTMENT; "RTN","RCDPEWLP",377,0) .... S RCZ(RCZ,SEQ(344.491),"ADJ",SEQ(344.4911))="Dec adj $"_$J(0-$P(SEQ(344.4911,0),U,3),"",2)_" pending - " "RTN","RCDPEWLP",378,0) .... S RCZ(RCZ,SEQ(344.491),"ADJ",SEQ(344.4911),1)=$J("",4)_$P(SEQ(344.4911,0),U,9) "RTN","RCDPEWLP",379,0) ; "RTN","RCDPEWLP",380,0) F RCZ=1,2,0,-1 D:$D(RCZ(RCZ)) "RTN","RCDPEWLP",381,0) . I RCZ=1 D SET("PAYMENTS (LINES FOR RECEIPT):") "RTN","RCDPEWLP",382,0) . I RCZ=0,VALMCNT>0 D SET(" "),SET("ZERO DOLLAR PAYMENTS:") "RTN","RCDPEWLP",383,0) . I RCZ=-1,VALMCNT>0 D SET(" "),SET("LINES WITH NEGATIVE BALANCES STILL NEEDING TO BE DISTRIBUTED:") "RTN","RCDPEWLP",384,0) . S Z=0 F S Z=$O(RCZ(RCZ,Z)) Q:'Z D "RTN","RCDPEWLP",385,0) .. S Z0=RCZ(RCZ,Z),X="" "RTN","RCDPEWLP",386,0) .. S X=$$SETFLD^VALM1($P(Z0,U),X,"LINE #") "RTN","RCDPEWLP",387,0) .. S X=$$SETFLD^VALM1($S($P(Z0,U,7):$$BN1^PRCAFN($P(Z0,U,7)),1:$S(RCZ=0:"",1:"[SUSPENSE]")_$S($P(Z0,U,2)["**ADJ"&'$P($P(Z0,U,2),"ADJ",2):"TOTALS MISMATCH ADJ",1:$P(Z0,U,2))),X,"ACCOUNT") "RTN","RCDPEWLP",388,0) .. S X=$$SETFLD^VALM1($J(+$P(Z0,U,6),"",2),X,"AMOUNT") "RTN","RCDPEWLP",389,0) .. D SET(X) "RTN","RCDPEWLP",390,0) .. S Z1=0 F S Z1=$O(RCZ(RCZ,Z,"ADJ",Z1)) Q:'Z1 D "RTN","RCDPEWLP",391,0) ... D SET($J("",12)_$G(RCZ(RCZ,Z,"ADJ",Z1))) "RTN","RCDPEWLP",392,0) ... S Z2=0 F S Z2=$O(RCZ(RCZ,Z,"ADJ",Z1,Z2)) Q:'Z2 D SET($J("",12)_$G(RCZ(RCZ,Z,"ADJ",Z1,Z2))) "RTN","RCDPEWLP",393,0) Q "RTN","RCDPEWLP",394,0) ; "RTN","RCDPEWLP",395,0) SET(X) ; "RTN","RCDPEWLP",396,0) S VALMCNT=VALMCNT+1,^TMP("RCDPE_AP_EOB_PREVIEW",$J,VALMCNT,0)=X "RTN","RCDPEWLP",397,0) Q "RTN","RCDPEWLP",398,0) ; "RTN","RCDPEWLP",399,0) HDR ; "RTN","RCDPEWLP",400,0) D HDR^RCDPEWL Q "RTN","RCDPEWLP",401,0) ; "RTN","RCDPEWLP",402,0) FNL ; "RTN","RCDPEWLP",403,0) K ^TMP("RCDPE_AP_EOB_PREVIEW",$J) Q "RTN","RCDPEWLP",404,0) ; "RTN","RCDPEWLZ") 0^31^B23906831 "RTN","RCDPEWLZ",1,0) RCDPEWLZ ;ALB/PJH-Block Auto-decrease protocol ;09 Feb 2018 "RTN","RCDPEWLZ",2,0) ;;4.5;Accounts Receivable;**326,332**;Mar 20, 1995;Build 40 "RTN","RCDPEWLZ",3,0) ;;Per VA Directive 6402, this routine should not be modified. "RTN","RCDPEWLZ",4,0) Q "RTN","RCDPEWLZ",5,0) ; "RTN","RCDPEWLZ",6,0) BLOCK(RCERA) ; Stop/Allow Auto Decrease of zero balance denials "RTN","RCDPEWLZ",7,0) ; "RTN","RCDPEWLZ",8,0) ; Input - RCERA - IEN of ERA in #344.4 "RTN","RCDPEWLZ",9,0) ; "RTN","RCDPEWLZ",10,0) ; Check that the ERA has auto-decrease CARCs which are not decreased "RTN","RCDPEWLZ",11,0) N RCARRAY "RTN","RCDPEWLZ",12,0) D AUTO(RCERA,.RCARRAY) "RTN","RCDPEWLZ",13,0) ; "RTN","RCDPEWLZ",14,0) D FULL^VALM1 "RTN","RCDPEWLZ",15,0) S VALMBCK="R" "RTN","RCDPEWLZ",16,0) ; "RTN","RCDPEWLZ",17,0) I 'RCARRAY D G QUIT "RTN","RCDPEWLZ",18,0) .W !!,"This option is only valid if an ERA has auto-decrease CARCs." "RTN","RCDPEWLZ",19,0) ; "RTN","RCDPEWLZ",20,0) I RCARRAY("D") D G QUIT "RTN","RCDPEWLZ",21,0) .W !!,"This option is not valid, the ERA has already been auto-decreased." "RTN","RCDPEWLZ",22,0) ; "RTN","RCDPEWLZ",23,0) N RCSTA,X "RTN","RCDPEWLZ",24,0) S RCSTA=$$GET1^DIQ(344.4,RCERA_",",.19,"I") "RTN","RCDPEWLZ",25,0) ; "RTN","RCDPEWLZ",26,0) ; "RTN","RCDPEWLZ",27,0) W !!,"This option will " "RTN","RCDPEWLZ",28,0) W $S(RCSTA:"ALLOW the nightly process to auto-decrease",1:"STOP the nightly process from auto-decreasing") "RTN","RCDPEWLZ",29,0) W !," the CARCs on this ERA.",! "RTN","RCDPEWLZ",30,0) ; "RTN","RCDPEWLZ",31,0) I $$ASKSTAT(RCSTA)'=1 Q "RTN","RCDPEWLZ",32,0) ; "RTN","RCDPEWLZ",33,0) ; Update ERA "RTN","RCDPEWLZ",34,0) D UPD(RCERA,RCSTA) "RTN","RCDPEWLZ",35,0) ; "RTN","RCDPEWLZ",36,0) W !,"... CARCs on this ERA will "_$S(RCSTA:"",1:"NOT ")_"be auto-decreased ..." "RTN","RCDPEWLZ",37,0) ; "RTN","RCDPEWLZ",38,0) QUIT ; pause and rebuild the header "RTN","RCDPEWLZ",39,0) W !!,"press RETURN to continue: " "RTN","RCDPEWLZ",40,0) R X:DTIME "RTN","RCDPEWLZ",41,0) ; "RTN","RCDPEWLZ",42,0) N RCARC "RTN","RCDPEWLZ",43,0) S RCARC=$$WLH^RCDPEWLZ(+RCSCR) "RTN","RCDPEWLZ",44,0) S:RCARC]"" VALMHDR(4)=RCARC "RTN","RCDPEWLZ",45,0) Q "RTN","RCDPEWLZ",46,0) ; "RTN","RCDPEWLZ",47,0) ASKSTAT(RCSTA) ; ask if its okay to block to unblock from auto-decrease "RTN","RCDPEWLZ",48,0) ; 1 is yes, otherwise no "RTN","RCDPEWLZ",49,0) N DIR,DIQ2,DTOUT,DUOUT,X,Y "RTN","RCDPEWLZ",50,0) S DIR(0)="YO",DIR("B")="Y" "RTN","RCDPEWLZ",51,0) S DIR("A")="Do you want to "_$S(RCSTA:"ALLOW",1:"STOP")_" auto-decrease of this ERA" "RTN","RCDPEWLZ",52,0) D ^DIR "RTN","RCDPEWLZ",53,0) I $G(DTOUT)!($G(DUOUT)) S Y=-1 "RTN","RCDPEWLZ",54,0) Q Y "RTN","RCDPEWLZ",55,0) ; "RTN","RCDPEWLZ",56,0) AUTO(RCERA,RCARRAY) ; Search ERA for Auto-Decrease CARCs "RTN","RCDPEWLZ",57,0) ; INPUT - RCERA = ERA number/IEN "RTN","RCDPEWLZ",58,0) ; RCARRAY = return array reference "RTN","RCDPEWLZ",59,0) ; OUTPUT - RCARRAY = list of ERA lines and auto-decrease CARC/amounts for each line "RTN","RCDPEWLZ",60,0) ; "RTN","RCDPEWLZ",61,0) ; RCARRAY=1 "RTN","RCDPEWLZ",62,0) ; RCARRAY(1)="5.71;22;^10.00;23;" - list of decrease amounts for each auto-decrease CARC "RTN","RCDPEWLZ",63,0) ; RCARRAY(1,"D")=1 - indicates line is decreased already "RTN","RCDPEWLZ",64,0) ; RCARRAY(1,"B")=1 - indicates line is/was blocked "RTN","RCDPEWLZ",65,0) ; "RTN","RCDPEWLZ",66,0) N EOBIEN,PAYID,PAYNAM,RC3446,RCARC,RCBLK,RCDAY,RCPARM,RCRCVD,RCSUB,RCRTYPE,RCZERO "RTN","RCDPEWLZ",67,0) K RCARRAY "RTN","RCDPEWLZ",68,0) S RCARRAY=0,RCARRAY("D")=0 "RTN","RCDPEWLZ",69,0) ; Ignore ERA if total paid is not zero "RTN","RCDPEWLZ",70,0) Q:+$$GET1^DIQ(344.4,RCERA_",",.05) "RTN","RCDPEWLZ",71,0) ; Ignore ERA if removed from worklist "RTN","RCDPEWLZ",72,0) Q:+$$GET1^DIQ(344.4,RCERA_",",.16,"I") "RTN","RCDPEWLZ",73,0) ; Calculate process date by subtracting DENIAL decrease days from today's date "RTN","RCDPEWLZ",74,0) S RCDAY=$$FMADD^XLFDT(DT\1,-$$GET1^DIQ(344.61,"1,",.12)) "RTN","RCDPEWLZ",75,0) ; Compare to ERA received date "RTN","RCDPEWLZ",76,0) S RCRCVD=$$GET1^DIQ(344.4,RCERA_",",.07,"I") "RTN","RCDPEWLZ",77,0) ; If not already decreased then check that auto-decrease date is not already past "RTN","RCDPEWLZ",78,0) I $$GET1^DIQ(344.4,RCERA_",",4.03,"I")="",RCRCVD\10 S RCV5=1 "RTN","RCDPEX",72,0) S Z=0 F S Z=$O(^TMP("RCSAVE",$J,Z)) Q:'Z I $P($G(^(Z,0)),U)["835" K ^(0) Q ; Get rid of header node "RTN","RCDPEX",73,0) D DISP^RCDPESR0("^TMP(""RCSAVE"",$J)","^TMP($J,""RCRAW"")",1,"^TMP($J,""RCOUT"")",75) ; Get formatted 'raw' data "RTN","RCDPEX",74,0) K ^TMP("RCSAVE",$J) "RTN","RCDPEX",75,0) I $G(RCRAW) D "RTN","RCDPEX",76,0) . S RC=$O(^TMP($J,"RCOUT",""),-1)+1,^TMP($J,"RCOUT",RC)=" " "RTN","RCDPEX",77,0) . S RC=RC+1,^TMP($J,"RCOUT",RC)="**RAW DATA**" "RTN","RCDPEX",78,0) . S Z=0 F S Z=$O(^RCY(344.5,RCTDA,2,Z)) Q:'Z D "RTN","RCDPEX",79,0) .. F Z0=1:80:$L($G(^RCY(344.5,RCTDA,2,Z,0))) S RC=RC+1,^TMP($J,"RCOUT",RC)=$E($G(^RCY(344.5,RCTDA,2,Z,0)),Z0,Z0+79) "RTN","RCDPEX",80,0) ; "RTN","RCDPEX",81,0) S (RCPG,RCSTOP,Z)=0 "RTN","RCDPEX",82,0) F S Z=$O(RCXM(Z)) Q:'Z S ^TMP($J,"RCOUT",Z-999)=RCXM(Z) "RTN","RCDPEX",83,0) S Z="" "RTN","RCDPEX",84,0) F S Z=$O(^TMP($J,"RCOUT",Z)) Q:'Z D Q:RCSTOP "RTN","RCDPEX",85,0) . I $D(ZTQUEUED),$$S^%ZTLOAD S (RCSTOP,ZTSTOP)=1 K ZTREQ I +$G(RCPG) W !,"***TASK STOPPED BY USER***" Q "RTN","RCDPEX",86,0) . I 'RCPG!(($Y+5)>IOSL) D I RCSTOP Q "RTN","RCDPEX",87,0) .. D:RCPG ASK(.RCSTOP) I RCSTOP Q "RTN","RCDPEX",88,0) .. D HDR(RCTDA,.RCPG) "RTN","RCDPEX",89,0) . W !,$G(^TMP($J,"RCOUT",Z)) "RTN","RCDPEX",90,0) I 'RCSTOP,RCPG D ASK(.RCSTOP) "RTN","RCDPEX",91,0) ; "RTN","RCDPEX",92,0) I $D(ZTQUEUED) S ZTREQ="@" "RTN","RCDPEX",93,0) I '$D(ZTQUEUED) D ^%ZISC "RTN","RCDPEX",94,0) ; "RTN","RCDPEX",95,0) VPQ K ^TMP($J,"RCRAW"),^TMP($J,"RCOUT") "RTN","RCDPEX",96,0) S VALMBCK="R" "RTN","RCDPEX",97,0) Q "RTN","RCDPEX",98,0) ; "RTN","RCDPEX",99,0) SEL(RCDA,ONE) ; Select entry(s) from list "RTN","RCDPEX",100,0) ; RCDA = array returned if selections made "RTN","RCDPEX",101,0) ; RCDA(n)=ien of bill selected in file 344.5 "RTN","RCDPEX",102,0) ; ONE = if set to 1, only one selection can be made at a time "RTN","RCDPEX",103,0) N RC "RTN","RCDPEX",104,0) K RCDA "RTN","RCDPEX",105,0) D EN^VALM2($G(XQORNOD(0)),$S('$G(ONE):"",1:"S")) "RTN","RCDPEX",106,0) S RCDA=0 F S RCDA=$O(VALMY(RCDA)) Q:'RCDA S RC=$G(^TMP("RCDPEX-EOBDX",$J,RCDA)),RCDA(RCDA)=+$P(RC,U,2) "RTN","RCDPEX",107,0) Q "RTN","RCDPEX",108,0) ; "RTN","RCDPEX",109,0) ; "RTN","RCDPEX",110,0) DEL ; Delete messages from messages list - file 344.5 "RTN","RCDPEX",111,0) N RCDA,RCOK,RCTDA,RCTDAC,RCTYP,RCU,RC0,DIR,RCT,RCE,RCDIQ,RCX,Z,X,Y,XMSUBJ,XMTO,XMBODY,XMDUZ,XMZ "RTN","RCDPEX",112,0) D FULL^VALM1 "RTN","RCDPEX",113,0) S RCTDA=0 "RTN","RCDPEX",114,0) D SEL(.RCDA,1) "RTN","RCDPEX",115,0) S RCDA=$O(RCDA("")) "RTN","RCDPEX",116,0) I RCDA="" G DELQ "RTN","RCDPEX",117,0) S RCTDA=+RCDA(RCDA),RCTDAC=RCTDA_"," "RTN","RCDPEX",118,0) S RCPAYTP=$$PAYTYP(RCTDA) "RTN","RCDPEX",119,0) I RCPAYTP="ACH" W !!,"Deletion is not allowed. The ERA has a payment method of ACH." D PAUSE^VALM1 Q "RTN","RCDPEX",120,0) W ! "RTN","RCDPEX",121,0) S DIR(0)="YA",DIR("A",1)="This action will PERMANENTLY delete an EDI Lockbox message from your system",DIR("A",2)="A bulletin will be sent to report the deletion",DIR("A",3)=" " "RTN","RCDPEX",122,0) S DIR("A")="ARE YOU SURE YOU WANT TO CONTINUE? ",DIR("B")="NO" "RTN","RCDPEX",123,0) D ^DIR K DIR "RTN","RCDPEX",124,0) G:Y'=1 DELQ "RTN","RCDPEX",125,0) I '$$LOCK(RCTDA) G DELQ "RTN","RCDPEX",126,0) S RC0=$G(^RCY(344.5,RCTDA,0)) "RTN","RCDPEX",127,0) ; "RTN","RCDPEX",128,0) I $P(RC0,U,5) S RCOK=1 D G:'RCOK DELQ "RTN","RCDPEX",129,0) . N ZTSK "RTN","RCDPEX",130,0) . S ZTSK=$P(RC0,U,5) D STAT^%ZTLOAD Q:ZTSK(0)=0 ;Task not scheduled "RTN","RCDPEX",131,0) . I "12"[ZTSK(1) W *7,!,"This message is currently scheduled for update. Task # is: ",$P(RC0,U,11) S RCOK="" D PAUSE^VALM1 "RTN","RCDPEX",132,0) ; "RTN","RCDPEX",133,0) S DIR(0)="YA",DIR("A",1)=" ",DIR("A",2)="",$P(DIR("A",2),"*",54)="",DIR("A",3)="* This EDI Lockbox message is about to be PERMANENTLY deleted!! *",DIR("A",4)=DIR("A",2),DIR("A",5)=" " "RTN","RCDPEX",134,0) S DIR("A")="ARE YOU STILL SURE YOU WANT TO CONTINUE? ",DIR("B")="NO" "RTN","RCDPEX",135,0) W ! D ^DIR W ! K DIR "RTN","RCDPEX",136,0) I Y'=1 W !!,"Nothing deleted" D PAUSE^VALM1 G DELQ "RTN","RCDPEX",137,0) ; "RTN","RCDPEX",138,0) D GETS^DIQ(344.5,RCTDAC,"*","IEN","RCDIQ") "RTN","RCDPEX",139,0) S RCE=0 "RTN","RCDPEX",140,0) D TXTDE(RCTDA,.RCDIQ,1,.RCX,.RCE) "RTN","RCDPEX",141,0) S RCE=RCE+1,RCX(RCE)="RAW MESSAGE DATA:" "RTN","RCDPEX",142,0) D TXTDE(RCTDA,.RCDIQ,2,.RCX,.RCE) "RTN","RCDPEX",143,0) D DELMSG(RCTDA) "RTN","RCDPEX",144,0) I $D(^RCY(344.5,RCTDA)) D G DELQ "RTN","RCDPEX",145,0) . W !,"Message not deleted - problem with delete" D PAUSE^VALM1 "RTN","RCDPEX",146,0) ; "RTN","RCDPEX",147,0) I $P(RC0,U,2)["XFR",'$P(RC0,U,14) D "RTN","RCDPEX",148,0) . S DIR(0)="YA" "RTN","RCDPEX",149,0) . S DIR("A")="ARE YOU DELETING THIS BECAUSE THE EEOB DOES NOT BELONG TO YOUR SITE?: ",DIR("B")="YES",DIR("?")="IF YOU RESPOND YES TO THIS QUESTION, A REJECT MESSAGE WILL BE SENT BACK TO",DIR("?",1)=" THE SENDING SITE FOR THIS EEOB" "RTN","RCDPEX",150,0) . W ! D ^DIR K DIR "RTN","RCDPEX",151,0) . Q:Y'=1 "RTN","RCDPEX",152,0) . D SENDACK^RCDPESR5(RCTDA,0) ; Send reject notice "RTN","RCDPEX",153,0) S RCT(1)="Electronic EDI Lockbox message "_$P(RC0,U)_" has been deleted" "RTN","RCDPEX",154,0) S RCT(2)=" " "RTN","RCDPEX",155,0) S RCT(3)="DELETED BY: "_$P($G(^VA(200,+$G(DUZ),0)),U)_" "_$$FMTE^XLFDT($$NOW^XLFDT,2) "RTN","RCDPEX",156,0) S RCT(4)=" ",RCE=+$O(RCT(""),-1) "RTN","RCDPEX",157,0) S Z=0 F S Z=$O(RCX(Z)) Q:'Z S RCE=RCE+1,RCT(RCE)=RCX(Z) "RTN","RCDPEX",158,0) S RCE=RCE+1,RCT(RCE)=" " "RTN","RCDPEX",159,0) S XMSUBJ="EDI LBOX MESSAGE DELETED",XMBODY="RCT",XMDUZ="",XMTO("G.RCDPE PAYMENTS")="" "RTN","RCDPEX",160,0) N DUZ S DUZ=.5,DUZ(0)="@" "RTN","RCDPEX",161,0) D SENDMSG^XMXAPI(.5,XMSUBJ,XMBODY,.XMTO,,.XMZ) "RTN","RCDPEX",162,0) ; "RTN","RCDPEX",163,0) W !,"A bulletin has been sent to report this deletion",! "RTN","RCDPEX",164,0) D PAUSE^VALM1 "RTN","RCDPEX",165,0) ; "RTN","RCDPEX",166,0) D BLD^RCDPEX1("TRANSMISSION") "RTN","RCDPEX",167,0) DELQ L -^RCY(344.5,RCTDA,0) "RTN","RCDPEX",168,0) S VALMBCK="R" "RTN","RCDPEX",169,0) Q "RTN","RCDPEX",170,0) ; "RTN","RCDPEX",171,0) DELMSG(RCTDA) ; Delete message from temporary message holding file 344.5 "RTN","RCDPEX",172,0) ; "RTN","RCDPEX",173,0) N DIK,DA,Y S DIK="^RCY(344.5,",DA=RCTDA D ^DIK "RTN","RCDPEX",174,0) Q "RTN","RCDPEX",175,0) ; "RTN","RCDPEX",176,0) TASK(RCRTN,RCTDA) ; Schedule the task to update data base from message "RTN","RCDPEX",177,0) ; RCRTN = routine to task "RTN","RCDPEX",178,0) ; RCTDA = internal entry of message in file 344.5 "RTN","RCDPEX",179,0) ; "RTN","RCDPEX",180,0) N ZTSK,ZTDESC,ZTIO,ZTDTH,ZTSAVE,DA,DR,DIE "RTN","RCDPEX",181,0) S ZTIO="",ZTDTH=$H,ZTDESC="UPDATE DATA BASE FROM EEOB EXCEPTION PROCESSING",ZTSAVE("RC*")="",ZTRTN=RCRTN "RTN","RCDPEX",182,0) D ^%ZTLOAD "RTN","RCDPEX",183,0) I $G(ZTSK),$G(^RCY(344.5,RCTDA,0)) D "RTN","RCDPEX",184,0) . S DIE="^RCY(344.5,",DR=".05////"_ZTSK_";.04////1;.08////0",DA=RCTDA D ^DIE "RTN","RCDPEX",185,0) Q $G(ZTSK) "RTN","RCDPEX",186,0) ; "RTN","RCDPEX",187,0) LOCK(RCTDA) ; Attempt to lock message file entry RCTDA in file 344.5 "RTN","RCDPEX",188,0) ; Return 1 if successful, 0 if not able to lock "RTN","RCDPEX",189,0) ; "RTN","RCDPEX",190,0) N OK "RTN","RCDPEX",191,0) S OK=1 "RTN","RCDPEX",192,0) L +^RCY(344.5,RCTDA,0):5 "RTN","RCDPEX",193,0) I '$T D "RTN","RCDPEX",194,0) . I '$D(DIQUIET) W !,*7,"Another user is editing this entry ... please try again later" D PAUSE^VALM1 "RTN","RCDPEX",195,0) . S OK=0 "RTN","RCDPEX",196,0) Q OK "RTN","RCDPEX",197,0) ; "RTN","RCDPEX",198,0) HDR(RCTDA,RCPG) ;Prints report heading "RTN","RCDPEX",199,0) ; RCTDA = ien of file 344.5 "RTN","RCDPEX",200,0) ; RCPG = page # last printed "RTN","RCDPEX",201,0) N Z "RTN","RCDPEX",202,0) I RCPG!($E(IOST,1,2)="C-") W @IOF,*13 "RTN","RCDPEX",203,0) I 'RCPG D "RTN","RCDPEX",204,0) . N RCX,RCZ "RTN","RCDPEX",205,0) . D TXT0(RCTDA,.RCZ,.RCX,0) ; Get 0-node captioned fields "RTN","RCDPEX",206,0) . S Z=0 F S Z=$O(RCX(Z)) Q:'Z S ^TMP($J,"RCHDR_EX",Z)=RCX(Z) "RTN","RCDPEX",207,0) S RCPG=RCPG+1 "RTN","RCDPEX",208,0) W !,?15,"EDI LBOX - EEOB EXCEPTIONS - EEOB DETAIL",?55,$$FMTE^XLFDT(DT,2),?70,"Page: ",RCPG,! "RTN","RCDPEX",209,0) S Z=0 F S Z=$O(^TMP($J,"RCHDR_EX",Z)) Q:'Z W !,$G(^(Z)) "RTN","RCDPEX",210,0) W !,$TR($J("",IOM)," ","=") "RTN","RCDPEX",211,0) Q "RTN","RCDPEX",212,0) ; "RTN","RCDPEX",213,0) ASK(RCSTOP) ; Ask to stop "RTN","RCDPEX",214,0) ; RCSTOP: passed by ref, flag to stop processing "RTN","RCDPEX",215,0) I $E(IOST,1,2)'["C-" Q "RTN","RCDPEX",216,0) N DIR,DIROUT,DIRUT,DTOUT,DUOUT "RTN","RCDPEX",217,0) S DIR(0)="E" W ! D ^DIR "RTN","RCDPEX",218,0) I ($D(DIRUT))!($D(DUOUT)) S RCSTOP=1 Q "RTN","RCDPEX",219,0) Q "RTN","RCDPEX",220,0) ; *** "RTN","RCDPEX",221,0) ; *** Entrypoints TXT* assume these parameter definitions *** "RTN","RCDPEX",222,0) ; *** "RTN","RCDPEX",223,0) ; FUNCTIONs returns RCXM1 and RCCT if passed by reference "RTN","RCDPEX",224,0) ; RCTDA = ien, file 344.5 "RTN","RCDPEX",225,0) ; RCXM1 = the array returned with text, captioned "RTN","RCDPEX",226,0) ; RCCT = # of lines already in array (optional) "RTN","RCDPEX",227,0) ; RCDIQ = the array returned from GETS^DIQ "RTN","RCDPEX",228,0) ; *** "RTN","RCDPEX",229,0) ; "RTN","RCDPEX",230,0) TXT0(RCTDA,RCDIQ,RCXM1,RCCT) ; Append 0-node captioned data to array RCXM1 "RTN","RCDPEX",231,0) ; See above for parameter definitions "RTN","RCDPEX",232,0) ; "RTN","RCDPEX",233,0) N RCZ,RCTDAC,LINE,DAT,Z,Z0 "RTN","RCDPEX",234,0) S LINE="",RCCT=+$G(RCCT),RCTDAC=RCTDA_"," "RTN","RCDPEX",235,0) S Z=0 F S Z=$O(RCDIQ(344.5,RCTDAC,Z)) Q:'Z!(Z'<1) D "RTN","RCDPEX",236,0) . S Z0=$$GET1^DID(344.5,Z,,"LABEL") "RTN","RCDPEX",237,0) . S DAT=Z0_": "_$G(RCDIQ(344.5,RCTDAC,Z,"E")) "RTN","RCDPEX",238,0) . I $L(DAT)>39 S:$L(LINE) RCCT=RCCT+1,RCXM1(RCCT)=LINE S RCCT=RCCT+1,RCXM1(RCCT)=DAT,LINE="" Q "RTN","RCDPEX",239,0) . I $L(LINE) D Q:LINE="" ; Left side exists "RTN","RCDPEX",240,0) .. I $L(LINE)+$L(DAT)>75 S RCCT=RCCT+1,RCXM1(RCCT)=LINE,LINE=DAT Q "RTN","RCDPEX",241,0) .. S LINE=LINE_" "_DAT,RCCT=RCCT+1,RCXM1(RCCT)=LINE,LINE="" "RTN","RCDPEX",242,0) . S LINE=$E(DAT_$J("",39),1,39) "RTN","RCDPEX",243,0) I $L(LINE) S RCCT=RCCT+1,RCXM1(RCCT)=LINE "RTN","RCDPEX",244,0) S:RCCT RCCT=RCCT+1,RCXM1(RCCT)=" " "RTN","RCDPEX",245,0) Q "RTN","RCDPEX",246,0) ; "RTN","RCDPEX",247,0) TXTDE(RCTDA,RCDIQ,RCNODE,RCXM1,RCCT) ; Append display data to array RCXM1 "RTN","RCDPEX",248,0) ; See above for parameter definitions "RTN","RCDPEX",249,0) ; RCNODE = the WP field # to return "RTN","RCDPEX",250,0) ; "RTN","RCDPEX",251,0) N RCCT1,LINE,Z,RCTDAC "RTN","RCDPEX",252,0) S LINE="",RCCT=+$G(RCCT),RCCT1=RCCT "RTN","RCDPEX",253,0) S RCTDAC=RCTDA_"," "RTN","RCDPEX",254,0) S Z=0 F S Z=$O(RCDIQ(344.5,RCTDAC,RCNODE,Z)) Q:'Z D "RTN","RCDPEX",255,0) . S RCCT=RCCT+1,RCXM1(RCCT)=$G(RCDIQ(344.5,RCTDAC,RCNODE,Z)) "RTN","RCDPEX",256,0) S:RCCT'=RCCT1 RCCT=RCCT+1,RCXM1(RCCT)=" " "RTN","RCDPEX",257,0) Q "RTN","RCDPEX",258,0) ; "RTN","RCDPEX",259,0) PAYTYP(RCTDA) ;Find pay source - PRCA*4.5*298 "RTN","RCDPEX",260,0) N RCPT,X "RTN","RCDPEX",261,0) S RCPT="" "RTN","RCDPEX",262,0) S X=$G(^RCY(344.5,RCTDA,2,1,0)) "RTN","RCDPEX",263,0) I $P(X,U)="835ERA" S RCPT=$P(X,U,17) "RTN","RCDPEX",264,0) Q RCPT "RTN","RCDPEX1") 0^7^B23011676 "RTN","RCDPEX1",1,0) RCDPEX1 ;ALB/TMK - ELECTRONIC EOB MESSAGE EXCEPTIONS PROCESS ;2 Aug 2018 21:41:05 "RTN","RCDPEX1",2,0) ;;4.5;Accounts Receivable;**173,262,298,304,326,332**;Mar 20, 1995;Build 40 "RTN","RCDPEX1",3,0) ;Per VA Directive 6402, this routine should not be modified. "RTN","RCDPEX1",4,0) ; "RTN","RCDPEX1",5,0) EN ; Main entry point "RTN","RCDPEX1",6,0) D DT^DICRW "RTN","RCDPEX1",7,0) N RCFASTXT,RCDA,RCEXCTYP,RCINCEX,DIR,Y,X,RCPAR,RCPAY,RCQUIT,RCTYPE,XX "RTN","RCDPEX1",8,0) ; Ask for TRANSMISSION exceptions or DATA exceptions "RTN","RCDPEX1",9,0) S DIR("A")="DO YOU WANT TO SEE (T)RANSMISSION OR (D)ATA EXCEPTIONS?: ",DIR("B")="T",DIR(0)="SAO^T:TRANSMISSION;D:DATA" "RTN","RCDPEX1",10,0) S DIR("?",1)="TRANSMISSION EXCEPTIONS INCLUDE ANY PROBLEM ENCOUNTERED WHEN AN ERA/EEOB",DIR("?",2)=" IS RECEIVED AT THE SITE AND BEFORE IT IS STORED PERMANENTLY IN VISTA." "RTN","RCDPEX1",11,0) S DIR("?",3)=" THIS INCLUDES PARTIAL MESSAGE RECEIPTS, EXTRACT PROBLEMS AND EEOBs THAT ",DIR("?",4)=" WERE TRANSFERRED IN FROM ANOTHER SITE." "RTN","RCDPEX1",12,0) S DIR("?",5)="DATA EXCEPTIONS INCLUDE EEOB DETAIL RECORDS FOR SPECIFIC BILLS THAT CAN'T BE" "RTN","RCDPEX1",13,0) S DIR("?",6)=" FULLY PROCESSED INTO THE VISTA SYSTEM. THIS INCLUDES EEOB DETAIL FOR",DIR("?",7)=" CLAIMS THAT NEED TO BE TRANSFERRED TO ANOTHER SITE OR WHOSE DETAIL COULD",DIR("?")=" NOT BE STORED IN IB" "RTN","RCDPEX1",14,0) D ^DIR K DIR "RTN","RCDPEX1",15,0) I Y=""!(Y="^") Q "RTN","RCDPEX1",16,0) S RCEXCTYP=Y,RCQUIT=0 "RTN","RCDPEX1",17,0) I RCEXCTYP="D" D ; Include exceptions for MEDICAL, PHARMACY or BOTH - PRCA*4.5*298 Filter question for medical, pharmacy or both "RTN","RCDPEX1",18,0) . S RCTYPE=$$RTYPE^RCDPEU1("A") ; PRCA*4.5*326 Pick MEDICAL/PHARMACY/TRICARE/ALL "RTN","RCDPEX1",19,0) . I RCTYPE=-1 S RCQUIT=1 Q "RTN","RCDPEX1",20,0) . ; "RTN","RCDPEX1",21,0) . S RCPAY=$$PAYRNG^RCDPEU1() ; PRCA*4.5*326 New payer selection "RTN","RCDPEX1",22,0) . I RCTYPE=-1 S RCQUIT=1 Q "RTN","RCDPEX1",23,0) . I RCPAY'="A" D ; "RTN","RCDPEX1",24,0) .. S RCPAR("TYPE")=RCTYPE,RCPAR("SELC")=RCPAY "RTN","RCDPEX1",25,0) .. S RCPAR("DICA")="Select Insurance Company NAME: " "RTN","RCDPEX1",26,0) .. S XX=$$SELPAY^RCDPEU1(.RCPAR) "RTN","RCDPEX1",27,0) .. I XX=-1 S RCQUIT=1 "RTN","RCDPEX1",28,0) ; "RTN","RCDPEX1",29,0) ; Exit if the user asks to exit. "RTN","RCDPEX1",30,0) I RCQUIT Q "RTN","RCDPEX1",31,0) ; "RTN","RCDPEX1",32,0) ; Transmission exceptions "RTN","RCDPEX1",33,0) I RCEXCTYP="T" D EN^VALM("RCDPEX EOB EXCEPTION LIST") "RTN","RCDPEX1",34,0) I RCEXCTYP="D" D EN^VALM("RCDPEX EOB_SUM EXCEPTION LIST") "RTN","RCDPEX1",35,0) K RCFASTXT,RCDA "RTN","RCDPEX1",36,0) Q "RTN","RCDPEX1",37,0) ; "RTN","RCDPEX1",38,0) EN1 ; Duplicate ERA Worklist [RCDPE DUPLICATE ERA WORKLIST] option "RTN","RCDPEX1",39,0) D EN^VALM("RCDPEX DUPLICATE ERA LIST") "RTN","RCDPEX1",40,0) K RCFASTXT,RCDA "RTN","RCDPEX1",41,0) Q "RTN","RCDPEX1",42,0) ; "RTN","RCDPEX1",43,0) INITD ; set up initial variables (RCDPEX DUPLICATE ERA LIST) "RTN","RCDPEX1",44,0) S U="^",VALMCNT=0,VALMBG=1 "RTN","RCDPEX1",45,0) D BLD("DUPLICATE ERA") "RTN","RCDPEX1",46,0) Q "RTN","RCDPEX1",47,0) ; "RTN","RCDPEX1",48,0) INIT ; set up initial variables "RTN","RCDPEX1",49,0) S U="^",VALMCNT=0,VALMBG=1 "RTN","RCDPEX1",50,0) D BLD("TRANSMISSION") "RTN","RCDPEX1",51,0) Q "RTN","RCDPEX1",52,0) ; "RTN","RCDPEX1",53,0) BLD(MODE) ; EP - from RCDPEX -- build list of messages "RTN","RCDPEX1",54,0) ; INPUT: MODE = "TRANSMISSION" or "DUPLICATE ERA" "RTN","RCDPEX1",55,0) ; OUTPUT: ^TMP("RCDPEX-EOB",$J) "RTN","RCDPEX1",56,0) N DA,DR,RCSEQ,RCMSG,RCS,RCER,RCDPDATA,RC0,RCDUP,X,Z "RTN","RCDPEX1",57,0) K ^TMP("RCDPEX-EOB",$J),^TMP("RCDPEX-EOBDX",$J) "RTN","RCDPEX1",58,0) S (RCMSG,RCSEQ,VALMCNT)=0 "RTN","RCDPEX1",59,0) ; Extract from 344.5 "RTN","RCDPEX1",60,0) F S RCMSG=$O(^RCY(344.5,"AEXC",1,RCMSG)) Q:'RCMSG S RC0=$G(^RCY(344.5,RCMSG,0)) D "RTN","RCDPEX1",61,0) . ; Check if message is on duplicate ERA worklist "RTN","RCDPEX1",62,0) . S RCDUP=+$$GET1^DIQ(344.5,RCMSG_",",.15,"I") "RTN","RCDPEX1",63,0) . ; Only display messages relevant to worklist type "RTN","RCDPEX1",64,0) . I MODE="TRANSMISSION",RCDUP Q "RTN","RCDPEX1",65,0) . I MODE="DUPLICATE ERA",'RCDUP Q "RTN","RCDPEX1",66,0) . ; add to list "RTN","RCDPEX1",67,0) . S RCSEQ=RCSEQ+1 "RTN","RCDPEX1",68,0) . S DR=".01:.03;.1;.11",DA=RCMSG D DIQ3445(DA,DR) "RTN","RCDPEX1",69,0) . S X="" "RTN","RCDPEX1",70,0) . S X=$$SETSTR^VALM1($E(RCSEQ_" ",1,4)_" "_$G(RCDPDATA(344.5,RCMSG,.01,"E")),"",1,26) ;(#.01) MESSAGE ID [1F] "RTN","RCDPEX1",71,0) . S X=$$SETSTR^VALM1(" "_$E($G(RCDPDATA(344.5,RCMSG,.02,"I")),4,6),X,27,9) ;(#.02) MESSAGE TYPE [2S] "RTN","RCDPEX1",72,0) . S X=$$SETSTR^VALM1(" "_$G(RCDPDATA(344.5,RCMSG,.03,"E")),X,36,22) ;(#.03) DATE RECORDED [3D] "RTN","RCDPEX1",73,0) . S X=$$SETSTR^VALM1(" "_$G(RCDPDATA(344.5,RCMSG,.11,"E")),X,58,17) ;(#.11) MAIL MESSAGE [11F] "RTN","RCDPEX1",74,0) . D SET(X,344.5,RCMSG,RCSEQ) "RTN","RCDPEX1",75,0) . S X=" EXCEPTION: "_$G(RCDPDATA(344.5,RCMSG,.1,"E")) ;(#.1) EXCEPTION CATEGORY [10S] "RTN","RCDPEX1",76,0) . D SET(X,344.5,RCMSG,RCSEQ) "RTN","RCDPEX1",77,0) . S DR=1,DA=RCMSG D DIQ3445(DA,DR) ;(#1) DISPLAY DATA "RTN","RCDPEX1",78,0) . S Z=0 F S Z=$O(RCDPDATA(344.5,RCMSG,1,Z)) Q:'Z S X=" "_RCDPDATA(344.5,RCMSG,1,Z) D SET(X,344.5,RCMSG,RCSEQ) "RTN","RCDPEX1",79,0) ; "RTN","RCDPEX1",80,0) I '$D(^TMP("RCDPEX-EOB",$J)) S VALMCNT=2,^TMP("RCDPEX-EOB",$J,1,0)=" ",^TMP("RCDPEX-EOB",$J,2,0)=" There Are No EEOB Exception Records On File" "RTN","RCDPEX1",81,0) Q "RTN","RCDPEX1",82,0) ; "RTN","RCDPEX1",83,0) FNL ; -- Clean up list "RTN","RCDPEX1",84,0) K ^TMP("RCDPEX-EOBDX",$J),^TMP("RCDPEU1",$J) ; PRCA*4.5*326 "RTN","RCDPEX1",85,0) D CLEAN^VALM10 "RTN","RCDPEX1",86,0) K RCFASTXT "RTN","RCDPEX1",87,0) Q "RTN","RCDPEX1",88,0) ; "RTN","RCDPEX1",89,0) SET(X,FILE,RCMSG,RCSEQ) ; -- set arrays for EOB exception records "RTN","RCDPEX1",90,0) ; X = the data to set into the global "RTN","RCDPEX1",91,0) S VALMCNT=VALMCNT+1,^TMP("RCDPEX-EOB",$J,VALMCNT,0)=X "RTN","RCDPEX1",92,0) S ^TMP("RCDPEX-EOB",$J,"IDX",VALMCNT,RCSEQ)="" "RTN","RCDPEX1",93,0) S ^TMP("RCDPEX-EOBDX",$J,RCSEQ)=VALMCNT_U_RCMSG_U_FILE "RTN","RCDPEX1",94,0) Q "RTN","RCDPEX1",95,0) ; "RTN","RCDPEX1",96,0) HDR ; "RTN","RCDPEX1",97,0) S VALMHDR(1)=$J("",21)_"ERA/EEOB MESSAGES WITH EXCEPTION CONDITIONS" "RTN","RCDPEX1",98,0) S VALMHDR(2)=" " "RTN","RCDPEX1",99,0) Q "RTN","RCDPEX1",100,0) ; "RTN","RCDPEX1",101,0) HDR1 ; "RTN","RCDPEX1",102,0) S VALMHDR(1)=$J("",21)_"Duplicate 835ERA Messages",VALMHDR(2)=" " "RTN","RCDPEX1",103,0) Q "RTN","RCDPEX1",104,0) ; "RTN","RCDPEX1",105,0) DIQ3445(DA,DR) ; DIQ call to retrieve data for DR fields in file 344.5 "RTN","RCDPEX1",106,0) N %I,D0,DIC,DIQ,DIQ2,YY "RTN","RCDPEX1",107,0) K RCDPDATA(344.5) "RTN","RCDPEX1",108,0) S DIQ(0)="EI",DIC="^RCY(344.5,",DIQ="RCDPDATA" D EN^DIQ1 "RTN","RCDPEX1",109,0) Q "RTN","RCDPEX1",110,0) ; "RTN","RCDPEX1",111,0) DIQ3444(DA,DR) ; DIQ call to retrieve data for DR fields in file 344.4 "RTN","RCDPEX1",112,0) N %I,D0,DIC,DIQ,DIQ2,YY "RTN","RCDPEX1",113,0) K RCDPDATA(344.4) "RTN","RCDPEX1",114,0) S DIQ(0)="EI",DIC="^RCY(344.4,",DIQ="RCDPDATA" D EN^DIQ1 "RTN","RCDPEX1",115,0) Q "RTN","RCDPEX1",116,0) ; "RTN","RCDPEX5") 0^5^B66895490 "RTN","RCDPEX5",1,0) RCDPEX5 ;ALB/TMK,DWA - ELECTRONIC EOB EXCEPTION PROCESSING - FILE 344.5 ;8 Aug 2018 21:44:13 "RTN","RCDPEX5",2,0) ;;4.5;Accounts Receivable;**332**;Mar 20, 1995;Build 40 "RTN","RCDPEX5",3,0) ;Per VA Directive 6402, this routine should not be modified. "RTN","RCDPEX5",4,0) Q "RTN","RCDPEX5",5,0) ; "RTN","RCDPEX5",6,0) UPD ; Update (File) ERA msgs manually from DUPLICATE exception list for file 344.5 "RTN","RCDPEX5",7,0) N RC0,RCDA,RCLKBXDA,RCOK,RCTSK,RCTYP,RCU,ZTSK "RTN","RCDPEX5",8,0) D FULL^VALM1 "RTN","RCDPEX5",9,0) D SEL(.RCDA,1) "RTN","RCDPEX5",10,0) S RCDA=$O(RCDA("")) "RTN","RCDPEX5",11,0) I RCDA="" G UPDQ "RTN","RCDPEX5",12,0) S RCLKBXDA=+RCDA(RCDA) "RTN","RCDPEX5",13,0) S RC0=$G(^RCY(344.5,RCLKBXDA,0)) "RTN","RCDPEX5",14,0) I RC0="" D G UPDQ "RTN","RCDPEX5",15,0) . W !,$C(7)_"ERA #"_RCDA_" is no longer in exception file" S RCOK=0 "RTN","RCDPEX5",16,0) . D PAUSE^VALM1 "RTN","RCDPEX5",17,0) ; "RTN","RCDPEX5",18,0) I '$$LOCK(RCLKBXDA) D G UPDQ "RTN","RCDPEX5",19,0) . W !,$C(7)_"Could not Lock ERA #"_RCDA_" to file it." S RCOK=0 "RTN","RCDPEX5",20,0) . D PAUSE^VALM1 "RTN","RCDPEX5",21,0) ; "RTN","RCDPEX5",22,0) S RC0=$G(^RCY(344.5,RCLKBXDA,0)) "RTN","RCDPEX5",23,0) I RC0="" D G UPDQ "RTN","RCDPEX5",24,0) . W !,$C(7)_"ERA #"_RCDA_" is no longer in exception file" S RCOK=0 "RTN","RCDPEX5",25,0) . D PAUSE^VALM1 "RTN","RCDPEX5",26,0) I $P(RC0,U,5) S RCOK=1 D G:'RCOK UPDQ "RTN","RCDPEX5",27,0) . N ZTSK "RTN","RCDPEX5",28,0) . S ZTSK=$P(RC0,U,5) D STAT^%ZTLOAD Q:ZTSK(0)=0 ;Task not scheduled "RTN","RCDPEX5",29,0) . I "12"[ZTSK(1) W !,$C(7)_"This record has already been scheduled for update. Task # is: "_$P(RC0,U,5) S RCOK="" D PAUSE^VALM1 "RTN","RCDPEX5",30,0) ; "RTN","RCDPEX5",31,0) S RCTYP=$P(RC0,U,2) "RTN","RCDPEX5",32,0) S RCU=$S(RCTYP="835ERA":"NEWERA^RCDPESR2("_RCLKBXDA_",1)",RCTYP="835XFR":"FILEEOB^RCDPESR5("_RCLKBXDA_")",1:"") "RTN","RCDPEX5",33,0) I RCU="" W !,$C(7)_"This message has an invalid 'type' - can't update" D PAUSE^VALM1 G UPDQ "RTN","RCDPEX5",34,0) S RCTSK=$$TASK(RCU,RCLKBXDA) "RTN","RCDPEX5",35,0) I RCTSK W !,"File update has been tasked (#"_RCTSK_")" "RTN","RCDPEX5",36,0) I 'RCTSK W !,$C(7)_"File update could not be tasked. Please try again later!" "RTN","RCDPEX5",37,0) D PAUSE^VALM1 "RTN","RCDPEX5",38,0) ; "RTN","RCDPEX5",39,0) D BLD^RCDPEX1("DUPLICATE ERA") "RTN","RCDPEX5",40,0) UPDQ ; fall through or GOTO from above "RTN","RCDPEX5",41,0) I $G(RCLKBXDA) L -^RCY(344.5,RCLKBXDA) "RTN","RCDPEX5",42,0) S VALMBCK="R" "RTN","RCDPEX5",43,0) Q "RTN","RCDPEX5",44,0) ; "RTN","RCDPEX5",45,0) VP ; View/Print ERA Messages - File 344.5 "RTN","RCDPEX5",46,0) N DHD,DIC,FLDS,BY,FR,TO,DIR,Y,L,RCDA,RCTDA,RCRAW,POP "RTN","RCDPEX5",47,0) D FULL^VALM1,SEL(.RCDA,1) "RTN","RCDPEX5",48,0) S RCDA=$O(RCDA("")) "RTN","RCDPEX5",49,0) G:'RCDA VPQ "RTN","RCDPEX5",50,0) S RCTDA=$G(RCDA(RCDA)) "RTN","RCDPEX5",51,0) S DIR(0)="YA",DIR("A")="DO YOU WANT TO INCLUDE DATA THE WAY IT WAS RECEIVED (RAW DATA)?: ",DIR("B")="N" D ^DIR K DIR "RTN","RCDPEX5",52,0) I $D(DUOUT)!$D(DTOUT) G VPQ "RTN","RCDPEX5",53,0) S RCRAW=+Y "RTN","RCDPEX5",54,0) ; Ask device "RTN","RCDPEX5",55,0) N %ZIS,ZTRTN,ZTSAVE,ZTDESC "RTN","RCDPEX5",56,0) S %ZIS="QM" D ^%ZIS G:POP VPQ "RTN","RCDPEX5",57,0) I $D(IO("Q")) D G VPQ "RTN","RCDPEX5",58,0) . S ZTRTN="VPOUT^RCDPEX",ZTDESC="AR - Print EEOB Exception Message" "RTN","RCDPEX5",59,0) . S ZTSAVE("RCTDA")="",ZTSAVE("RCRAW")="" "RTN","RCDPEX5",60,0) . D ^%ZTLOAD "RTN","RCDPEX5",61,0) . W !!,$S($D(ZTSK):"Your task number"_ZTSK_" has been queued.",1:"Unable to queue this job.") "RTN","RCDPEX5",62,0) . K ZTSK,IO("Q") D HOME^%ZIS "RTN","RCDPEX5",63,0) U IO "RTN","RCDPEX5",64,0) ; "RTN","RCDPEX5",65,0) VPOUT ; Entrypoint for queued job "RTN","RCDPEX5",66,0) N Z,Z0,RCSTOP,RCPG,RCXM,RCXM1,RC,RCZ,RCTDAC,RCV5 "RTN","RCDPEX5",67,0) K ^TMP($J,"RCRAW"),^TMP($J,"RCOUT") "RTN","RCDPEX5",68,0) S RCTDAC=RCTDA_",",RCV5=0 "RTN","RCDPEX5",69,0) ; "RTN","RCDPEX5",70,0) D GETS^DIQ(344.5,RCTDAC,"*","IEN","RCZ") "RTN","RCDPEX5",71,0) D TXTDE^RCDPEX(RCTDA,.RCZ,1,.RCXM,.RC) "RTN","RCDPEX5",72,0) ; "RTN","RCDPEX5",73,0) I $O(^RCY(344.5,RCTDA,"EX",0)) D "RTN","RCDPEX5",74,0) . S RC=RC+1,RCXM(RC)="**EXCEPTION MESSAGES**" "RTN","RCDPEX5",75,0) . D TXTDE^RCDPEX(RCTDA,.RCZ,5,.RCXM,.RC) "RTN","RCDPEX5",76,0) ; "RTN","RCDPEX5",77,0) K ^TMP("RCSAVE",$J) "RTN","RCDPEX5",78,0) M ^TMP("RCSAVE",$J)=^RCY(344.5,RCTDA,2) "RTN","RCDPEX5",79,0) I +$P($G(^TMP("RCSAVE",$J,1,0)),U,16)>0 S RCV5=1 "RTN","RCDPEX5",80,0) S Z=0 F S Z=$O(^TMP("RCSAVE",$J,Z)) Q:'Z I $P($G(^(Z,0)),U)["835" K ^(0) Q ; Get rid of header node "RTN","RCDPEX5",81,0) D DISP^RCDPESR0("^TMP(""RCSAVE"",$J)","^TMP($J,""RCRAW"")",1,"^TMP($J,""RCOUT"")",75) ; Get formatted 'raw' data "RTN","RCDPEX5",82,0) K ^TMP("RCSAVE",$J) "RTN","RCDPEX5",83,0) I $G(RCRAW) D "RTN","RCDPEX5",84,0) . S RC=$O(^TMP($J,"RCOUT",""),-1)+1,^TMP($J,"RCOUT",RC)=" " "RTN","RCDPEX5",85,0) . S RC=RC+1,^TMP($J,"RCOUT",RC)="**RAW DATA**" "RTN","RCDPEX5",86,0) . S Z=0 F S Z=$O(^RCY(344.5,RCTDA,2,Z)) Q:'Z D "RTN","RCDPEX5",87,0) .. F Z0=1:80:$L($G(^RCY(344.5,RCTDA,2,Z,0))) S RC=RC+1,^TMP($J,"RCOUT",RC)=$E($G(^RCY(344.5,RCTDA,2,Z,0)),Z0,Z0+79) "RTN","RCDPEX5",88,0) ; "RTN","RCDPEX5",89,0) S (RCPG,RCSTOP,Z)=0 "RTN","RCDPEX5",90,0) F S Z=$O(RCXM(Z)) Q:'Z S ^TMP($J,"RCOUT",Z-999)=RCXM(Z) "RTN","RCDPEX5",91,0) S Z="" "RTN","RCDPEX5",92,0) F S Z=$O(^TMP($J,"RCOUT",Z)) Q:'Z D Q:RCSTOP "RTN","RCDPEX5",93,0) . I $D(ZTQUEUED),$$S^%ZTLOAD S (RCSTOP,ZTSTOP)=1 K ZTREQ I +$G(RCPG) W !,"***TASK STOPPED BY USER***" Q "RTN","RCDPEX5",94,0) . I 'RCPG!(($Y+5)>IOSL) D I RCSTOP Q "RTN","RCDPEX5",95,0) .. D:RCPG ASK^RCDPEX(.RCSTOP) I RCSTOP Q "RTN","RCDPEX5",96,0) .. D HDR(RCTDA,.RCPG) "RTN","RCDPEX5",97,0) . W !,$G(^TMP($J,"RCOUT",Z)) "RTN","RCDPEX5",98,0) I 'RCSTOP,RCPG D ASK^RCDPEX(.RCSTOP) "RTN","RCDPEX5",99,0) ; "RTN","RCDPEX5",100,0) I $D(ZTQUEUED) S ZTREQ="@" "RTN","RCDPEX5",101,0) I '$D(ZTQUEUED) D ^%ZISC "RTN","RCDPEX5",102,0) ; "RTN","RCDPEX5",103,0) VPQ K ^TMP($J,"RCRAW"),^TMP($J,"RCOUT") "RTN","RCDPEX5",104,0) S VALMBCK="R" "RTN","RCDPEX5",105,0) Q "RTN","RCDPEX5",106,0) ; "RTN","RCDPEX5",107,0) SEL(RCDA,ONE) ; Select entry(s) from list "RTN","RCDPEX5",108,0) ; RCDA = array returned if selections made "RTN","RCDPEX5",109,0) ; RCDA(n)=ien of bill selected in file 344.5 "RTN","RCDPEX5",110,0) ; ONE = if set to 1, only one selection can be made at a time "RTN","RCDPEX5",111,0) N RC "RTN","RCDPEX5",112,0) K RCDA "RTN","RCDPEX5",113,0) D EN^VALM2($G(XQORNOD(0)),$S('$G(ONE):"",1:"S")) "RTN","RCDPEX5",114,0) S RCDA=0 F S RCDA=$O(VALMY(RCDA)) Q:'RCDA S RC=$G(^TMP("RCDPEX-EOBDX",$J,RCDA)),RCDA(RCDA)=+$P(RC,U,2) "RTN","RCDPEX5",115,0) Q "RTN","RCDPEX5",116,0) ; "RTN","RCDPEX5",117,0) DEL ; RCDPEX DELETE DUP MESSAGE option "RTN","RCDPEX5",118,0) ; Delete messages from messages list - file 344.5 "RTN","RCDPEX5",119,0) N DIR,RC0,RCDA,RCDIQ,RCE,RCLKBXDA,RCOK,RCPAYTP,RCT,RCTYP,RCU,RCX,Z "RTN","RCDPEX5",120,0) D FULL^VALM1 "RTN","RCDPEX5",121,0) S RCLKBXDA=0 "RTN","RCDPEX5",122,0) D SEL(.RCDA,1) "RTN","RCDPEX5",123,0) S RCDA=$O(RCDA("")) "RTN","RCDPEX5",124,0) I RCDA="" G DELQ "RTN","RCDPEX5",125,0) S RCLKBXDA=+RCDA(RCDA),RCLKBXDA("iens")=RCLKBXDA_"," "RTN","RCDPEX5",126,0) S RCPAYTP=$$PAYTYP^RCDPEX(RCLKBXDA) "RTN","RCDPEX5",127,0) S DIR(0)="YA",DIR("A",1)="This action will PERMANENTLY delete an EDI Lockbox message from your system",DIR("A",2)="A bulletin will be sent to report the deletion",DIR("A",3)=" " "RTN","RCDPEX5",128,0) S DIR("A")="Are you sure you want to continue? ",DIR("B")="NO" "RTN","RCDPEX5",129,0) W ! D ^DIR K DIR "RTN","RCDPEX5",130,0) G:Y'=1 DELQ "RTN","RCDPEX5",131,0) I '$$LOCK(RCLKBXDA) D G DELQ "RTN","RCDPEX5",132,0) . K DIR "RTN","RCDPEX5",133,0) . S DIR(0)="EA",DIR("A",1)=" ",DIR("A",2)="Unable to lock the EDI LOCKBOX MESSAGE for deletion." "RTN","RCDPEX5",134,0) . S DIR("A")="Press ENTER: " D ^DIR "RTN","RCDPEX5",135,0) S RC0=$G(^RCY(344.5,RCLKBXDA,0)) "RTN","RCDPEX5",136,0) ; "RTN","RCDPEX5",137,0) I $P(RC0,U,5) S RCOK=1 D G:'RCOK DELQ "RTN","RCDPEX5",138,0) . N ZTSK "RTN","RCDPEX5",139,0) . S ZTSK=$P(RC0,U,5) D STAT^%ZTLOAD Q:ZTSK(0)=0 ;Task not scheduled "RTN","RCDPEX5",140,0) . I "12"[ZTSK(1) W !,$C(7)_"This Lockbox message is scheduled for update. Task # is: "_$P(RC0,U,11) S RCOK="" D PAUSE^VALM1 "RTN","RCDPEX5",141,0) ; "RTN","RCDPEX5",142,0) S DIR(0)="YA",DIR("A",1)=" ",DIR("A",2)="",$P(DIR("A",2),"*",66)="",DIR("A",3)="* This EDI Lockbox message is about to be PERMANENTLY deleted!! *",DIR("A",4)=DIR("A",2),DIR("A",5)=" " "RTN","RCDPEX5",143,0) S DIR("A")="Are you STILL sure you want to continue? ",DIR("B")="NO" "RTN","RCDPEX5",144,0) W ! D ^DIR W ! K DIR "RTN","RCDPEX5",145,0) I Y'=1 W !!,"Nothing deleted" D PAUSE^VALM1 G DELQ "RTN","RCDPEX5",146,0) ; "RTN","RCDPEX5",147,0) D SNDMLMN(RCLKBXDA),LKBXDEL(RCLKBXDA) "RTN","RCDPEX5",148,0) I $D(^RCY(344.5,RCLKBXDA)) D G DELQ "RTN","RCDPEX5",149,0) . W !,"EDI Lockbox message not deleted - problem with deletion." D PAUSE^VALM1 "RTN","RCDPEX5",150,0) ; "RTN","RCDPEX5",151,0) W !,"A MailMan message has been sent to report this deletion.",! "RTN","RCDPEX5",152,0) D PAUSE^VALM1,BLD^RCDPEX1("DUPLICATE ERA") "RTN","RCDPEX5",153,0) ; "RTN","RCDPEX5",154,0) DELQ ; fall through or GOTO here "RTN","RCDPEX5",155,0) L -^RCY(344.5,RCLKBXDA,0) "RTN","RCDPEX5",156,0) S VALMBCK="R" "RTN","RCDPEX5",157,0) Q "RTN","RCDPEX5",158,0) ; "RTN","RCDPEX5",159,0) SNDMLMN(RCLKBXDA) ; send MailMan message about RCLKBXDA entry in 344.5 "RTN","RCDPEX5",160,0) N J,LN,RCDPDATA,X,XMINSTR,XMTO,XMZ,Y "RTN","RCDPEX5",161,0) K ^TMP($J,"RCMMSG") ; mail text storage "RTN","RCDPEX5",162,0) S DR=".01:.04;.07:.15" "RTN","RCDPEX5",163,0) D DIQ3445^RCDPEX1(RCLKBXDA,DR) ; returns RCDPDATA array "RTN","RCDPEX5",164,0) ; create MailMan text "RTN","RCDPEX5",165,0) S LN=1,^TMP($J,"RCMMSG",LN,0)="An EDI LOCKBOX MESSAGE was deleted "_$$FMTE^XLFDT($$NOW^XLFDT) "RTN","RCDPEX5",166,0) S LN=LN+1,^TMP($J,"RCMMSG",LN,0)="The user: "_$$GET1^DIQ(200,DUZ_",",.01)_" (User #"_DUZ_")" "RTN","RCDPEX5",167,0) S LN=LN+1,^TMP($J,"RCMMSG",LN,0)=" ",LN=LN+1,^TMP($J,"RCMMSG",LN,0)="Deleted Lockbox Message Information: " "RTN","RCDPEX5",168,0) ; add data and field labels to message "RTN","RCDPEX5",169,0) F J=.01:.01:.04,.07:.01:.15 D "RTN","RCDPEX5",170,0) . S X=$G(RCDPDATA(344.5,RCLKBXDA,J,"E")) Q:X="" ; skip null fields "RTN","RCDPEX5",171,0) . S LN=LN+1,^TMP($J,"RCMMSG",LN,0)=" > "_$$GET1^DID(344.5,J,"","LABEL")_": "_X "RTN","RCDPEX5",172,0) ; send as a priority message "RTN","RCDPEX5",173,0) S XMTO(DUZ)="",XMTO("G.RCDPE PAYMENTS MGMT")="",XMINSTR("FLAGS")="P" "RTN","RCDPEX5",174,0) D SENDMSG^XMXAPI(DUZ,"EDI LOCKBOX MESSAGE DELETION",$NA(^TMP($J,"RCMMSG")),.XMTO,.XMINSTR,.XMZ) "RTN","RCDPEX5",175,0) I '$G(ZTSK),$E(IOST,1,2)="C-",$G(XMZ) W !,"MailMan message #"_XMZ_" sent." "RTN","RCDPEX5",176,0) K ^TMP($J,"RCMMSG") "RTN","RCDPEX5",177,0) Q "RTN","RCDPEX5",178,0) ; "RTN","RCDPEX5",179,0) LKBXDEL(RCLKBXDA) ;Delete entry from AR EDI LOCKBOX MESSAGES file "RTN","RCDPEX5",180,0) N DA,DIC,DIK,X,Y S DIK="^RCY(344.5,",DA=RCLKBXDA D ^DIK "RTN","RCDPEX5",181,0) Q "RTN","RCDPEX5",182,0) ; "RTN","RCDPEX5",183,0) TASK(RCRTN,RCLKBXDA) ;function, Schedule the task to update data base from message "RTN","RCDPEX5",184,0) ; RCRTN - routine to task "RTN","RCDPEX5",185,0) ; RCLKBXDA - IEN in file 344.5 "RTN","RCDPEX5",186,0) ; returns: TaskMan task # "RTN","RCDPEX5",187,0) N ZTSK,ZTDESC,ZTIO,ZTDTH,ZTSAVE,DA,DR,DIE "RTN","RCDPEX5",188,0) S ZTIO="",ZTDTH=$H,ZTDESC="UPDATE DATA BASE FROM EEOB EXCEPTION PROCESSING",ZTSAVE("RC*")="",ZTRTN=RCRTN "RTN","RCDPEX5",189,0) D ^%ZTLOAD "RTN","RCDPEX5",190,0) I $G(ZTSK),$G(^RCY(344.5,RCLKBXDA,0)) D "RTN","RCDPEX5",191,0) . S DIE="^RCY(344.5,",DR=".05///"_ZTSK_";.04///1;.08///0",DA=RCLKBXDA D ^DIE "RTN","RCDPEX5",192,0) Q $G(ZTSK) "RTN","RCDPEX5",193,0) ; "RTN","RCDPEX5",194,0) LOCK(RCLKBXDA) ; Boolean function, lock entry RCLKBXDA in file 344.5 "RTN","RCDPEX5",195,0) ; Return 1 if successful, else zero "RTN","RCDPEX5",196,0) Q:'($G(RCLKBXDA)>0) "^no 344.5 IEN to lock" ; error message is also false "RTN","RCDPEX5",197,0) N LCK L +^RCY(344.5,RCLKBXDA,0):DILOCKTM S LCK=$T "RTN","RCDPEX5",198,0) Q LCK "RTN","RCDPEX5",199,0) ; "RTN","RCDPEX5",200,0) HDR(RCTDA,RCPG) ;Prints report heading "RTN","RCDPEX5",201,0) ; RCTDA = ien of file 344.5 "RTN","RCDPEX5",202,0) ; RCPG = page # last printed "RTN","RCDPEX5",203,0) N Z "RTN","RCDPEX5",204,0) I RCPG!($E(IOST,1,2)="C-") W @IOF,*13 "RTN","RCDPEX5",205,0) I 'RCPG D "RTN","RCDPEX5",206,0) . N RCX,RCZ "RTN","RCDPEX5",207,0) . D TXT0^RCDPEX(RCTDA,.RCZ,.RCX,0) ; Get 0-node captioned fields "RTN","RCDPEX5",208,0) . S Z=0 F S Z=$O(RCX(Z)) Q:'Z S ^TMP($J,"RCHDR_EX",Z)=RCX(Z) "RTN","RCDPEX5",209,0) S RCPG=RCPG+1 "RTN","RCDPEX5",210,0) W !,?15,"EDI LBOX - DUPLICATE ERA - EEOB DETAIL",?55,$$FMTE^XLFDT(DT,2),?70,"Page: ",RCPG,! "RTN","RCDPEX5",211,0) S Z=0 F S Z=$O(^TMP($J,"RCHDR_EX",Z)) Q:'Z W !,$G(^(Z)) "RTN","RCDPEX5",212,0) W !,$TR($J("",IOM)," ","=") "RTN","RCDPEX5",213,0) Q "RTN","RCDPLPL3") 0^36^B61808211 "RTN","RCDPLPL3",1,0) RCDPLPL3 ;WISC/RFJ - link payments listmanager options (link payment) ;1 Jun 00 "RTN","RCDPLPL3",2,0) ;;4.5;Accounts Receivable;**153,304,301,321,332**;Mar 20, 1995;Build 40 "RTN","RCDPLPL3",3,0) ;;Per VA Directive 6402, this routine should not be modified. "RTN","RCDPLPL3",4,0) Q "RTN","RCDPLPL3",5,0) ; "RTN","RCDPLPL3",6,0) ; "RTN","RCDPLPL3",7,0) LINKPAY ; link a payment to an account "RTN","RCDPLPL3",8,0) N DA,DIR,DIRUT,DIROUT,DTOUT,DUOUT,RCEEOB,X,Y ; PRCA*4.5*321 - added RCEEOB "RTN","RCDPLPL3",9,0) ; "RTN","RCDPLPL3",10,0) D FULL^VALM1 "RTN","RCDPLPL3",11,0) S VALMBCK="R" "RTN","RCDPLPL3",12,0) ; "RTN","RCDPLPL3",13,0) W !!,"This option will allow the account to be entered for an unapplied" "RTN","RCDPLPL3",14,0) W !,"payment transaction selected from the above list. If the selected" "RTN","RCDPLPL3",15,0) W !,"receipt has been previously processed, the selected account in the" "RTN","RCDPLPL3",16,0) W !,"accounts receivable package will be updated with the payment.",! "RTN","RCDPLPL3",17,0) N INDEX,RCDPFLAG,RCERROR,RCGECSCR,RCPAY,RCRECTDA,RCSTATUS,RCTRANDA,RCDCHKSW,HRCDCKSW,RCDPTYPE "RTN","RCDPLPL3",18,0) S INDEX=$$SELPAY^RCDPLPL1 I 'INDEX Q "RTN","RCDPLPL3",19,0) S RCPAY=$G(^TMP("RCDPLPLM",$J,"IDX",INDEX,INDEX)) "RTN","RCDPLPL3",20,0) S RCRECTDA=+$P(RCPAY,"^"),RCTRANDA=+$P(RCPAY,"^",2) "RTN","RCDPLPL3",21,0) ; "RTN","RCDPLPL3",22,0) I '$$LOCKREC^RCDPRPLU(RCRECTDA) Q "RTN","RCDPLPL3",23,0) S RCDPTYPE=$P(^RCY(344,RCRECTDA,1,RCTRANDA,0),"^",19) "RTN","RCDPLPL3",24,0) ; "RTN","RCDPLPL3",25,0) ; check to see if the cr document has been sent for the receipt "RTN","RCDPLPL3",26,0) S RCGECSCR=$P($G(^RCY(344,RCRECTDA,2)),"^") "RTN","RCDPLPL3",27,0) ; code sheet already sent once, this is a retransmission, check it "RTN","RCDPLPL3",28,0) I RCGECSCR'="" D "RTN","RCDPLPL3",29,0) . S RCSTATUS=$$STATUS^GECSSGET(RCGECSCR) "RTN","RCDPLPL3",30,0) . W !!,"This receipt has been processed to FMS with cash receipt document" "RTN","RCDPLPL3",31,0) . W !,$TR(RCGECSCR," "),". The current status for this document in the" "RTN","RCDPLPL3",32,0) . W !,"Generic Code Sheet Stack file is ",RCSTATUS,"." "RTN","RCDPLPL3",33,0) . ; "RTN","RCDPLPL3",34,0) . ; okay to continue if status is Error, Rejected, or not defined (-1) "RTN","RCDPLPL3",35,0) . I $E(RCSTATUS)="E"!($E(RCSTATUS)="R")!(RCSTATUS=-1) Q "RTN","RCDPLPL3",36,0) . ; okay to continue if status is Accepted "RTN","RCDPLPL3",37,0) . I $E(RCSTATUS)="A" Q "RTN","RCDPLPL3",38,0) . ; okay to continue if document is transmitted for 2 days "RTN","RCDPLPL3",39,0) . I $E(RCSTATUS)="T",$$FMDIFF^XLFDT(DT,$P(^RCY(344,RCRECTDA,0),"^",8))>1 Q "RTN","RCDPLPL3",40,0) . ; "RTN","RCDPLPL3",41,0) . W !!,"You cannot link the payment to an account until the FMS cash receipt" "RTN","RCDPLPL3",42,0) . W !,"document is either Accepted or Rejected by FMS." "RTN","RCDPLPL3",43,0) . W !," 1. If the FMS cash receipt is Accepted by FMS, you will need to" "RTN","RCDPLPL3",44,0) . W !," remove the payment from the station's suspense account online" "RTN","RCDPLPL3",45,0) . W !," in FMS." "RTN","RCDPLPL3",46,0) . W !," 2. If the FMS cash receipt document is rejected by FMS, you can" "RTN","RCDPLPL3",47,0) . W !," use the option Process Receipt under the Receipt Processing" "RTN","RCDPLPL3",48,0) . W !," listmanager screen to regenerate the document. The payment" "RTN","RCDPLPL3",49,0) . W !," has not been deposited in the station's suspense account by" "RTN","RCDPLPL3",50,0) . W !," FMS since the cash receipt document rejected.",! "RTN","RCDPLPL3",51,0) . S VALMSG="Try linking this payment again tomorrow." "RTN","RCDPLPL3",52,0) . D WRITE^RCDPRPLU(VALMSG) "RTN","RCDPLPL3",53,0) . S RCDPFLAG=1 "RTN","RCDPLPL3",54,0) I $G(RCDPFLAG) D QUIT Q "RTN","RCDPLPL3",55,0) ; "RTN","RCDPLPL3",56,0) ; show payment transaction "RTN","RCDPLPL3",57,0) W !!,"The current payment transaction:",?40,"RECEIPT: ",$P(^RCY(344,RCRECTDA,0),"^") "RTN","RCDPLPL3",58,0) W !,"--------------------------------" "RTN","RCDPLPL3",59,0) D SHOWPAY(RCRECTDA,RCTRANDA) "RTN","RCDPLPL3",60,0) ; "RTN","RCDPLPL3",61,0) ; transaction has account entered "RTN","RCDPLPL3",62,0) I $P(^RCY(344,RCRECTDA,1,RCTRANDA,0),"^",3) D Q "RTN","RCDPLPL3",63,0) . S VALMSG="An account has been assigned to this payment." "RTN","RCDPLPL3",64,0) . D QUIT "RTN","RCDPLPL3",65,0) ; "RTN","RCDPLPL3",66,0) ; transaction is cancelled, cannot edit "RTN","RCDPLPL3",67,0) I '$P(^RCY(344,RCRECTDA,1,RCTRANDA,0),"^",4),$P($G(^RCY(344,RCRECTDA,1,RCTRANDA,1)),"^")'="" D Q "RTN","RCDPLPL3",68,0) . S VALMSG="Payment Transaction "_RCTRANDA_" is CANCELLED." "RTN","RCDPLPL3",69,0) . D WRITE^RCDPRPLU(VALMSG) "RTN","RCDPLPL3",70,0) . D QUIT "RTN","RCDPLPL3",71,0) ; "RTN","RCDPLPL3",72,0) ;PRCA*4.5*304 "RTN","RCDPLPL3",73,0) ; Will this link payment link to multiple bills "RTN","RCDPLPL3",74,0) ; Note: some of the code and logic below is also in tag PROCESS^RCDPLPL4. "RTN","RCDPLPL3",75,0) ; If changes in logic are made below, please review this tag as well. "RTN","RCDPLPL3",76,0) ; "RTN","RCDPLPL3",77,0) S DIR(0)="YO",DIR("B")="NO" "RTN","RCDPLPL3",78,0) S DIR("A")=" Will this transaction be linked to multiple claims (Y/N)" "RTN","RCDPLPL3",79,0) D ^DIR "RTN","RCDPLPL3",80,0) I $G(DTOUT)!($G(DUOUT)) D QUIT Q "RTN","RCDPLPL3",81,0) I +Y D MULTIPLE^RCDPLPL4(RCRECTDA,RCTRANDA,RCGECSCR,$G(RCSTATUS)) D QUIT Q "RTN","RCDPLPL3",82,0) ;end PRCA*4.5*304 "RTN","RCDPLPL3",83,0) ; "RTN","RCDPLPL3",84,0) W !!,"Editing Payment: ",RCTRANDA "RTN","RCDPLPL3",85,0) DBTRBIL S RCDCHKSW=1,HRCDCKSW=0 D EDITACCT^RCDPURET(RCRECTDA,RCTRANDA) I RCDCHKSW=0 G DBTRBIL ;prca*4.5*301 "RTN","RCDPLPL3",86,0) W ! "RTN","RCDPLPL3",87,0) ; account not entered "RTN","RCDPLPL3",88,0) I '$P(^RCY(344,RCRECTDA,1,RCTRANDA,0),"^",3) D Q "RTN","RCDPLPL3",89,0) . S VALMSG="Account was not linked." "RTN","RCDPLPL3",90,0) . D WRITE^RCDPRPLU(VALMSG) "RTN","RCDPLPL3",91,0) . D QUIT "RTN","RCDPLPL3",92,0) ; "RTN","RCDPLPL3",93,0) ; show payment transaction "RTN","RCDPLPL3",94,0) W !,"The NEW payment transaction:",?40,"RECEIPT: ",$P(^RCY(344,RCRECTDA,0),"^") "RTN","RCDPLPL3",95,0) W !,"-----------------------------" "RTN","RCDPLPL3",96,0) D SHOWPAY(RCRECTDA,RCTRANDA) "RTN","RCDPLPL3",97,0) ; "RTN","RCDPLPL3",98,0) I $$ASKACCT()'=1 D Q "RTN","RCDPLPL3",99,0) . D DELEACCT^RCDPURET(RCRECTDA,RCTRANDA) "RTN","RCDPLPL3",100,0) . S VALMSG="Account was deleted and not linked." "RTN","RCDPLPL3",101,0) . D WRITE^RCDPRPLU(VALMSG) "RTN","RCDPLPL3",102,0) . D QUIT "RTN","RCDPLPL3",103,0) ; "RTN","RCDPLPL3",104,0) ; Option to restore suspense EEOB - PRCA*4.5*321 "RTN","RCDPLPL3",105,0) S RCEEOB=$$EEOB^RCDPEM5(RCRECTDA,RCTRANDA) "RTN","RCDPLPL3",106,0) Q:RCEEOB<0 "RTN","RCDPLPL3",107,0) ; "RTN","RCDPLPL3",108,0) ; receipt has been processed since the cash receipt document "RTN","RCDPLPL3",109,0) ; has been generated. update the new account with payment "RTN","RCDPLPL3",110,0) W ! "RTN","RCDPLPL3",111,0) I RCGECSCR'="" D I RCERROR Q "RTN","RCDPLPL3",112,0) . W !,"Updating the Linked Account with the payment ..." "RTN","RCDPLPL3",113,0) . S RCERROR=$$PROCESS^RCBEPAY(RCRECTDA,RCTRANDA) "RTN","RCDPLPL3",114,0) . ; an error occurred during processing a payment "RTN","RCDPLPL3",115,0) . I RCERROR D Q "RTN","RCDPLPL3",116,0) . . W ! "RTN","RCDPLPL3",117,0) . . W !,"+------------------------------------------------------------------------------+" "RTN","RCDPLPL3",118,0) . . W !,"| An ERROR has occurred when processing payment ",RCTRANDA," on receipt ",$P(^RCY(344,RCRECTDA,0),"^"),".",?79,"|" "RTN","RCDPLPL3",119,0) . . W !,"| The error message returned during processing is:",?79,"|" "RTN","RCDPLPL3",120,0) . . W !,"|",?79,"|" "RTN","RCDPLPL3",121,0) . . W !,"| ",$P(RCERROR,"^",2),?79,"|" "RTN","RCDPLPL3",122,0) . . W !,"|",?79,"|" "RTN","RCDPLPL3",123,0) . . W !,"| You will need to correct the error before you can link the payment.",?79,"|" "RTN","RCDPLPL3",124,0) . . W !,"+------------------------------------------------------------------------------+" "RTN","RCDPLPL3",125,0) . . W ! "RTN","RCDPLPL3",126,0) . . D DELEACCT^RCDPURET(RCRECTDA,RCTRANDA) "RTN","RCDPLPL3",127,0) . . S VALMSG="Account was deleted and not linked." "RTN","RCDPLPL3",128,0) . . D WRITE^RCDPRPLU(VALMSG) "RTN","RCDPLPL3",129,0) . . D QUIT "RTN","RCDPLPL3",130,0) . ; "RTN","RCDPLPL3",131,0) . ; payment processed correctly "RTN","RCDPLPL3",132,0) . W " done." "RTN","RCDPLPL3",133,0) . W ! "RTN","RCDPLPL3",134,0) . ; "RTN","RCDPLPL3",135,0) . ;PRCA*4.5*304 "RTN","RCDPLPL3",136,0) . D REMCMT^RCDPLPL4(RCRECTDA,RCTRANDA) ; Remove the suspense comment. No longer needed. "RTN","RCDPLPL3",137,0) . ; "RTN","RCDPLPL3",138,0) . ;File entry in Audit Log "RTN","RCDPLPL3",139,0) . D AUDIT^RCBEPAY(RCRECTDA,RCTRANDA,"P") "RTN","RCDPLPL3",140,0) . ; "RTN","RCDPLPL3",141,0) . ; Update Suspense Status "RTN","RCDPLPL3",142,0) . D SUSPDIS^RCBEPAY(RCRECTDA,RCTRANDA,"PD") "RTN","RCDPLPL3",143,0) . ;end PRCA*4.5*304 "RTN","RCDPLPL3",144,0) . ; "RTN","RCDPLPL3",145,0) . ; Update EEOB claim number and restore to active status - PRCA*4.5*321 "RTN","RCDPLPL3",146,0) . D:RCEEOB RESTORE^RCDPEM5(RCRECTDA,RCTRANDA,RCEEOB,"L") "RTN","RCDPLPL3",147,0) . ; "RTN","RCDPLPL3",148,0) . ; PRCA*4.5*332 - If all money was split off the original EEOB remove it. "RTN","RCDPLPL3",149,0) . D CHKEOB^RCDPEU2(RCRECTDA,RCTRANDA) "RTN","RCDPLPL3",150,0) . ; "RTN","RCDPLPL3",151,0) . I $E($G(RCSTATUS))="A" D "RTN","RCDPLPL3",152,0) . . W !,"Since the FMS cash receipt document is Accepted in FMS, you need to go" "RTN","RCDPLPL3",153,0) . . W !,"online in FMS and transfer the amount paid out of the station's suspense" "RTN","RCDPLPL3",154,0) . . W !,"account.",! "RTN","RCDPLPL3",155,0) . . ; send mail message to the RCDP PAYMENTS mail group "RTN","RCDPLPL3",156,0) . . W !,"Sending mail message to RCDP PAYMENTS mail group." "RTN","RCDPLPL3",157,0) . . D MAILMSG^RCDPLPSR(RCRECTDA,RCTRANDA) "RTN","RCDPLPL3",158,0) . . ; place an x in the fms doc field so it will show on the "RTN","RCDPLPL3",159,0) . . ; suspense report "RTN","RCDPLPL3",160,0) . . D EDITFMS^RCDPURET(RCRECTDA,RCTRANDA,"x") "RTN","RCDPLPL3",161,0) . I $E($G(RCSTATUS))'="A" D "RTN","RCDPLPL3",162,0) . . W !,"Since the FMS cash receipt document is NOT Accepted in FMS, you can use" "RTN","RCDPLPL3",163,0) . . W !,"the option Process Receipt located under the Receipt Processing Menu" "RTN","RCDPLPL3",164,0) . . W !,"to regenerate the cash receipt document to FMS.",! "RTN","RCDPLPL3",165,0) . S VALMSG="Payment linked and removed from list." "RTN","RCDPLPL3",166,0) . D WRITE^RCDPRPLU(VALMSG) "RTN","RCDPLPL3",167,0) ; "RTN","RCDPLPL3",168,0) ; receipt has not been processed "RTN","RCDPLPL3",169,0) I RCGECSCR="" D "RTN","RCDPLPL3",170,0) . S VALMSG="Since the receipt has not been processed, accounts will not be updated." "RTN","RCDPLPL3",171,0) . D WRITE^RCDPRPLU(VALMSG) "RTN","RCDPLPL3",172,0) . S VALMSG="Payment linked and removed from list." "RTN","RCDPLPL3",173,0) . ; Update EEOB claim number and restore to active status - PRCA*4.5*321 "RTN","RCDPLPL3",174,0) . D:RCEEOB RESTORE^RCDPEM5(RCRECTDA,RCTRANDA,RCEEOB,"L") "RTN","RCDPLPL3",175,0) ; "RTN","RCDPLPL3",176,0) QUIT ; call here to unlock and rebuild list "RTN","RCDPLPL3",177,0) L -^RCY(344,RCRECTDA) "RTN","RCDPLPL3",178,0) D INIT^RCDPLPLM "RTN","RCDPLPL3",179,0) Q "RTN","RCDPLPL3",180,0) ; "RTN","RCDPLPL3",181,0) ; "RTN","RCDPLPL3",182,0) SHOWPAY(RCRECTDA,RCTRANDA) ; show the payment transaction "RTN","RCDPLPL3",183,0) N A,D0,DA,DIC,DIQ,DK,DL,DX,S,Y "RTN","RCDPLPL3",184,0) S DIC="^RCY(344,"_RCRECTDA_",1,",DA(1)=RCRECTDA,DA=RCTRANDA,DIQ(0)="C" "RTN","RCDPLPL3",185,0) D EN^DIQ "RTN","RCDPLPL3",186,0) Q "RTN","RCDPLPL3",187,0) ; "RTN","RCDPLPL3",188,0) ; "RTN","RCDPLPL3",189,0) ASKACCT() ; ask if its the correct account "RTN","RCDPLPL3",190,0) ; 1 is yes, otherwise no "RTN","RCDPLPL3",191,0) N DIR,DIQ2,DTOUT,DUOUT,X,Y "RTN","RCDPLPL3",192,0) S DIR(0)="YO",DIR("B")="NO" "RTN","RCDPLPL3",193,0) S DIR("A")=" Is this the correct ACCOUNT to apply the payment to" "RTN","RCDPLPL3",194,0) D ^DIR "RTN","RCDPLPL3",195,0) I $G(DTOUT)!($G(DUOUT)) S Y=-1 "RTN","RCDPLPL3",196,0) Q Y "RTN","RCDPLPL4") 0^37^B248709221 "RTN","RCDPLPL4",1,0) RCDPLPL4 ;ALB/SAB - Multiple Bill Link Payments ;17 Mar 16 "RTN","RCDPLPL4",2,0) ;;4.5;Accounts Receivable;**304,301,321,326,332**;Mar 20, 1995;Build 40 "RTN","RCDPLPL4",3,0) ;;Per VA Directive 6402, this routine should not be modified. "RTN","RCDPLPL4",4,0) ; "RTN","RCDPLPL4",5,0) Q "RTN","RCDPLPL4",6,0) ; "RTN","RCDPLPL4",7,0) MULTIPLE(RCRECTDA,RCTRANDA,RCGECSCR,RCSTATUS) ; Process multiple bills for the same receipt transaction. "RTN","RCDPLPL4",8,0) ; "RTN","RCDPLPL4",9,0) N RCAMT,RCCT,RCAMTRM,RCEXIT,RCMSG,RCNWTRAN,RCTACCT,RCTAMT,RCTDATA,RCACT,RCARRAY,RCEXT,RCRSP,RCSPRSS "RTN","RCDPLPL4",10,0) N RCDACNO,I,RCNM,RCBLIEN,RCDACNOI,RCUNAPN,RCQTSP,RCANS,RCDACT,RCDATA,RCPIEN,RCTACCTT "RTN","RCDPLPL4",11,0) N RCTAMT,RCTCMT,RCTDNM,RCUNRCN,RCDCHKSW,HRCDCKSW "RTN","RCDPLPL4",12,0) ; "RTN","RCDPLPL4",13,0) S (RCSPRSS,RCEXIT,RCCT)=0 "RTN","RCDPLPL4",14,0) S RCTDATA=$G(^RCY(344,RCRECTDA,1,RCTRANDA,0)) "RTN","RCDPLPL4",15,0) I RCTDATA="" D Q "RTN","RCDPLPL4",16,0) . S RCMSG="The initial receipt transaction data is missing. Unable to link a claim to this transaction." "RTN","RCDPLPL4",17,0) . D WRITE^RCDPRPLU(RCMSG) "RTN","RCDPLPL4",18,0) ; "RTN","RCDPLPL4",19,0) ; Retrieve payment amount on the transaction "RTN","RCDPLPL4",20,0) S (RCAMT,RCAMTRM)=+$P(RCTDATA,U,4) "RTN","RCDPLPL4",21,0) ; "RTN","RCDPLPL4",22,0) I RCAMT=0 D Q "RTN","RCDPLPL4",23,0) . S RCMSG="The transaction balance is 0. Unable to link a claim to this transaction." "RTN","RCDPLPL4",24,0) . D WRITE^RCDPRPLU(RCMSG) "RTN","RCDPLPL4",25,0) ; "RTN","RCDPLPL4",26,0) ;Retrieve list of Bills to link to payment "RTN","RCDPLPL4",27,0) F D Q:RCAMTRM=0 Q:RCEXIT "RTN","RCDPLPL4",28,0) . ; "RTN","RCDPLPL4",29,0) . ;Re-init the suspense quit flag "RTN","RCDPLPL4",30,0) . S RCQTSP=0 "RTN","RCDPLPL4",31,0) . ; "RTN","RCDPLPL4",32,0) . ;Ask the user for the account "RTN","RCDPLPL4",33,0) . S RCDCHKSW=1,HRCDCKSW=0,RCACCT=$$GETACCT(RCRECTDA) I RCDCHKSW=0 W ! Q ;prca*4.5*301 "RTN","RCDPLPL4",34,0) . I RCACCT=-1 D Q "RTN","RCDPLPL4",35,0) . . S RCRSP=$$CONQUIT() "RTN","RCDPLPL4",36,0) . . S:RCRSP=1 RCEXIT=1 "RTN","RCDPLPL4",37,0) . ; "RTN","RCDPLPL4",38,0) . I RCACCT=0 D Q "RTN","RCDPLPL4",39,0) . . W !,?6,"Invalid Bill Number, Please try again...." "RTN","RCDPLPL4",40,0) . S:RCACCT="SUSPENSE" RCACCT="" ;Payment needs to remain in suspense. "RTN","RCDPLPL4",41,0) . ; "RTN","RCDPLPL4",42,0) . ;Ask the user for the amount "RTN","RCDPLPL4",43,0) . S RCAMT=$$GETAMT(RCACCT,RCAMTRM) "RTN","RCDPLPL4",44,0) . Q:RCAMT=-1 "RTN","RCDPLPL4",45,0) . ; "RTN","RCDPLPL4",46,0) . ;Ask the user for Comment if no account is entered. "RTN","RCDPLPL4",47,0) . S RCCMT="" "RTN","RCDPLPL4",48,0) . I RCACCT="" S RCCMT=$$GETCMT() "RTN","RCDPLPL4",49,0) . ;timed out or ^ - exit. "RTN","RCDPLPL4",50,0) . I (RCCMT=-1)!(RCCMT="^") Q "RTN","RCDPLPL4",51,0) . ; "RTN","RCDPLPL4",52,0) . ;Update the array and amount remaining. "RTN","RCDPLPL4",53,0) . S RCCT=RCCT+1 "RTN","RCDPLPL4",54,0) . S RCARRAY(RCCT)=RCACCT_U_RCAMT_U_RCCMT_U_$$GETACTNM(RCACCT) "RTN","RCDPLPL4",55,0) . S RCAMTRM=RCAMTRM-RCAMT "RTN","RCDPLPL4",56,0) . ; "RTN","RCDPLPL4",57,0) . ;Check to see if user wishes to continue "RTN","RCDPLPL4",58,0) . I RCAMTRM>0 D "RTN","RCDPLPL4",59,0) . . ; "RTN","RCDPLPL4",60,0) . . ;ask if user wishes to continue "RTN","RCDPLPL4",61,0) . . S RCRSP=$$CONTINUE(RCAMTRM) "RTN","RCDPLPL4",62,0) . . ; "RTN","RCDPLPL4",63,0) . . ;User wishes to continue "RTN","RCDPLPL4",64,0) . . Q:RCRSP=1 "RTN","RCDPLPL4",65,0) . . ; "RTN","RCDPLPL4",66,0) . . ;if no, ask if user is sure and that all selected payments will not be linked. "RTN","RCDPLPL4",67,0) . . S RCRSP=$$CONQUIT() "RTN","RCDPLPL4",68,0) . . I RCRSP=1 S RCEXIT=1 "RTN","RCDPLPL4",69,0) ; "RTN","RCDPLPL4",70,0) ; If the user is exiting before completion, quit. "RTN","RCDPLPL4",71,0) Q:RCEXIT "RTN","RCDPLPL4",72,0) ; "RTN","RCDPLPL4",73,0) ;State all money is disbursed and display all accounts for confirmation "RTN","RCDPLPL4",74,0) W !!,"*** RECEIPT HAS BEEN FULLY DISBURSED ***",! "RTN","RCDPLPL4",75,0) ; "RTN","RCDPLPL4",76,0) ; Ask if user wishes to review the list again "RTN","RCDPLPL4",77,0) S RCANS=$$GETANS(1) "RTN","RCDPLPL4",78,0) ; "RTN","RCDPLPL4",79,0) ;Spacing line "RTN","RCDPLPL4",80,0) W ! "RTN","RCDPLPL4",81,0) ; "RTN","RCDPLPL4",82,0) ; Review the list if necessary "RTN","RCDPLPL4",83,0) I RCANS=1 D "RTN","RCDPLPL4",84,0) . S I=0 "RTN","RCDPLPL4",85,0) . W !,?5,"PATIENT NAME",?36,"ACCOUNT",?50,"PAYMENT TO APPLY",! "RTN","RCDPLPL4",86,0) . F I=1:1:RCCT D "RTN","RCDPLPL4",87,0) . . S (RCNM,RCDACNO,RCDACNOI)="" "RTN","RCDPLPL4",88,0) . . S RCDATA=$G(RCARRAY(I)) "RTN","RCDPLPL4",89,0) . . S RCDACT=$P(RCDATA,U) "RTN","RCDPLPL4",90,0) . . S:RCDACT="" RCNM="SUSPENSE" "RTN","RCDPLPL4",91,0) . . I RCDACT[";DPT" D "RTN","RCDPLPL4",92,0) . . . S RCNM=$P($G(^DPT($P(RCDACT,";"),0)),U) "RTN","RCDPLPL4",93,0) . . . S RCDACNO="" "RTN","RCDPLPL4",94,0) . . I RCDACT[";PRCA" D "RTN","RCDPLPL4",95,0) . . . S RCDACNOI=$P(RCDACT,";") "RTN","RCDPLPL4",96,0) . . . S RCDACNO=$P($G(^PRCA(430,$P(RCDACNOI,U),0)),U) "RTN","RCDPLPL4",97,0) . . . S RCPIEN=$P($G(^DGCR(399,RCDACNOI,0)),U,2) "RTN","RCDPLPL4",98,0) . . . I RCPIEN="" S RCNM="PATIENT NAME NOT FOUND" Q "RTN","RCDPLPL4",99,0) . . . S RCNM=$P($G(^DPT(RCPIEN,0)),U) "RTN","RCDPLPL4",100,0) . . . I RCNM="" S RCNM="PATIENT NAME NOT FOUND" "RTN","RCDPLPL4",101,0) . . W ?5,RCNM,?36,RCDACNO,?50,"$",$J($FN($P(RCDATA,U,2),",",2),15),! "RTN","RCDPLPL4",102,0) ; "RTN","RCDPLPL4",103,0) ; Ask the user if they wish to update. Quit if they time out, "^" out, or say No to updating. "RTN","RCDPLPL4",104,0) S RCANS=$$GETANS(2) "RTN","RCDPLPL4",105,0) Q:RCANS'=1 "RTN","RCDPLPL4",106,0) ; "RTN","RCDPLPL4",107,0) ;Initialize error flag "RTN","RCDPLPL4",108,0) S RCERROR=0 "RTN","RCDPLPL4",109,0) ; "RTN","RCDPLPL4",110,0) ;Surpress PNORBILL^RCDPURED output "RTN","RCDPLPL4",111,0) S RCSPRSS=1 "RTN","RCDPLPL4",112,0) ; "RTN","RCDPLPL4",113,0) ;create line spacing "RTN","RCDPLPL4",114,0) W !! "RTN","RCDPLPL4",115,0) ; "RTN","RCDPLPL4",116,0) ;Link the payments "RTN","RCDPLPL4",117,0) F RCACT=1:1:RCCT D Q:RCERROR "RTN","RCDPLPL4",118,0) . ; "RTN","RCDPLPL4",119,0) . ;Extract data to update "RTN","RCDPLPL4",120,0) . S RCTAMT=$P(RCARRAY(RCACT),U,2) ;Payment Amount "RTN","RCDPLPL4",121,0) . S RCTACCT=$P(RCARRAY(RCACT),U,1) ;Account to link to. "RTN","RCDPLPL4",122,0) . S RCTCMT=$P(RCARRAY(RCACT),U,3) "RTN","RCDPLPL4",123,0) . S RCTDNM=$P(RCARRAY(RCACT),U,4) "RTN","RCDPLPL4",124,0) . S RCTACCTT=$S(RCTACCT="":"the Suspense Item",1:RCTACCT) "RTN","RCDPLPL4",125,0) . ; "RTN","RCDPLPL4",126,0) . ;If not the first transaction, create a new one "RTN","RCDPLPL4",127,0) . I RCACT'=1 D Q "RTN","RCDPLPL4",128,0) . . ; "RTN","RCDPLPL4",129,0) . . ; Create new transaction "RTN","RCDPLPL4",130,0) . . S RCNWTRAN=$$COPYTRAN(RCRECTDA,RCTDATA,RCTAMT,RCGECSCR) "RTN","RCDPLPL4",131,0) . . ; "RTN","RCDPLPL4",132,0) . . ; Link the Payment using the display name "RTN","RCDPLPL4",133,0) . . D LINKPAY(RCRECTDA,RCNWTRAN,RCTDNM) "RTN","RCDPLPL4",134,0) . . ; "RTN","RCDPLPL4",135,0) . . ; build unapplied deposit number "RTN","RCDPLPL4",136,0) . . S RCUNRCN=$P($G(^RCY(344,RCRECTDA,0)),U) "RTN","RCDPLPL4",137,0) . . S RCUNAPN=$S($L(RCUNRCN)>9:$E(RCUNRCN,$L(RCUNRCN-9),$L(RCUNRCN)),1:RCUNRCN) "RTN","RCDPLPL4",138,0) . . S RCUNAPN=RCUNAPN_$E("0000",1,4-$L(RCNWTRAN))_RCNWTRAN "RTN","RCDPLPL4",139,0) . . D SETUNAPP^RCDPURET(RCRECTDA,RCNWTRAN,RCUNAPN) ; add new unapplied deposit # "RTN","RCDPLPL4",140,0) . . ; "RTN","RCDPLPL4",141,0) . . ; If creating a new suspense item, update the comment field and audit logs "RTN","RCDPLPL4",142,0) . . I RCTCMT'="" D "RTN","RCDPLPL4",143,0) . . . ; "RTN","RCDPLPL4",144,0) . . . D UPDCMT(RCRECTDA,RCNWTRAN,RCTCMT) ; add comment "RTN","RCDPLPL4",145,0) . . . I $G(RCGECSCR)'="" D "RTN","RCDPLPL4",146,0) . . . . D AUDIT^RCBEPAY(RCRECTDA,RCNWTRAN,"I") "RTN","RCDPLPL4",147,0) . . . . D SUSPDIS^RCBEPAY(RCRECTDA,RCNWTRAN,"P") "RTN","RCDPLPL4",148,0) . . . W !,"***** PAYMENT AMOUNT LEFT IN SUSPENSE = $",$J(RCTAMT,"",2)," ... done." "RTN","RCDPLPL4",149,0) . . ; "RTN","RCDPLPL4",150,0) . . ; If linking an account, process the linking "RTN","RCDPLPL4",151,0) . . I RCTCMT="" D "RTN","RCDPLPL4",152,0) . . . ; "RTN","RCDPLPL4",153,0) . . . ; If the receipt has been processed, process the payment "RTN","RCDPLPL4",154,0) . . . I $G(RCGECSCR)'="" D Q "RTN","RCDPLPL4",155,0) . . . . W !,RCTDNM," - Updating the Linked Account with PMT = $",$J(RCTAMT,"",2)," ... done." "RTN","RCDPLPL4",156,0) . . . . D REMCMT(RCRECTDA,RCNWTRAN) ; Remove the supense comment. No longer needed. "RTN","RCDPLPL4",157,0) . . . . D PROCESS(RCRECTDA,RCNWTRAN,RCTDNM) "RTN","RCDPLPL4",158,0) . . . ; "RTN","RCDPLPL4",159,0) . . . ; The receipt has not been processed "RTN","RCDPLPL4",160,0) . . . W !,RCTDNM," - Receipt has not been processed. Account linked but not" "RTN","RCDPLPL4",161,0) . . . W !,?6,"updated for the PMT = $",$J(RCTAMT,"",2) "RTN","RCDPLPL4",162,0) . ; "RTN","RCDPLPL4",163,0) . ;If this is the first transaction, adjust the payment amount to be the amount not split out. "RTN","RCDPLPL4",164,0) . I RCACT=1 D "RTN","RCDPLPL4",165,0) . . ; "RTN","RCDPLPL4",166,0) . . ; Modify the original payment amount "RTN","RCDPLPL4",167,0) . . D ADJTRAMT(RCRECTDA,RCTRANDA,RCTAMT,RCGECSCR,.RCARRAY) ; Added RCARRAY - PRCA*4.5*326 "RTN","RCDPLPL4",168,0) . . ; "RTN","RCDPLPL4",169,0) . . ; Adjusting the amount in suspense, update the comment field and audit logs "RTN","RCDPLPL4",170,0) . . I RCTCMT'="" D Q "RTN","RCDPLPL4",171,0) . . . D UPDCMT(RCRECTDA,RCTRANDA,RCTCMT) ; add comment "RTN","RCDPLPL4",172,0) . . . I $G(RCGECSCR)'="" D "RTN","RCDPLPL4",173,0) . . . . D AUDIT^RCBEPAY(RCRECTDA,RCTRANDA,"I") "RTN","RCDPLPL4",174,0) . . . . D SUSPDIS^RCBEPAY(RCRECTDA,RCTRANDA,"P") "RTN","RCDPLPL4",175,0) . . . W !,"***** PAYMENT AMOUNT LEFT IN SUSPENSE = $",$J(RCTAMT,"",2)," ... done." "RTN","RCDPLPL4",176,0) . . ; "RTN","RCDPLPL4",177,0) . . ; Link the Payment, send account if PRCA, Patient name in Patient "RTN","RCDPLPL4",178,0) . . D LINKPAY(RCRECTDA,RCTRANDA,RCTDNM) "RTN","RCDPLPL4",179,0) . . ; "RTN","RCDPLPL4",180,0) . . ;Remove the comment, item is no longer in suspense "RTN","RCDPLPL4",181,0) . . D REMCMT(RCRECTDA,RCTRANDA) "RTN","RCDPLPL4",182,0) . . ; "RTN","RCDPLPL4",183,0) . . ; If the receipt has been processed, process the payment "RTN","RCDPLPL4",184,0) . . I $G(RCGECSCR)'="" D Q "RTN","RCDPLPL4",185,0) . . . W !,RCTDNM," - Updating the Linked Account with PMT = $",$J(RCTAMT,"",2)," ... done." "RTN","RCDPLPL4",186,0) . . . D PROCESS(RCRECTDA,RCTRANDA,RCTDNM) "RTN","RCDPLPL4",187,0) . . ; "RTN","RCDPLPL4",188,0) . . ; The receipt has not been processed "RTN","RCDPLPL4",189,0) . . W !,RCTDNM," - Receipt has not been processed. Account linked but not" "RTN","RCDPLPL4",190,0) . . W !,?6,"updated for the PMT = $",$J(RCTAMT,"",2) "RTN","RCDPLPL4",191,0) ; "RTN","RCDPLPL4",192,0) ; PRCA*4.5*332 - If all money was split off the original EEOB remove it. "RTN","RCDPLPL4",193,0) D CHKEOB^RCDPEU2(RCRECTDA,RCTRANDA,.RCARRAY) "RTN","RCDPLPL4",194,0) ; "RTN","RCDPLPL4",195,0) W !! "RTN","RCDPLPL4",196,0) ; "RTN","RCDPLPL4",197,0) D ENDMSG(RCSTATUS) "RTN","RCDPLPL4",198,0) ; "RTN","RCDPLPL4",199,0) D WRITE^RCDPRPLU(" ") "RTN","RCDPLPL4",200,0) ; "RTN","RCDPLPL4",201,0) Q "RTN","RCDPLPL4",202,0) ; "RTN","RCDPLPL4",203,0) GETACCT(RCRECTDA) ; Ask the user for the account "RTN","RCDPLPL4",204,0) ; "RTN","RCDPLPL4",205,0) N X,Y,DTOUT,DUOUT,DIR,DIROUT,DIRUT,DA,RCSUSFLG,RCSTAT "RTN","RCDPLPL4",206,0) ; "RTN","RCDPLPL4",207,0) S RCSUSFLG=0 "RTN","RCDPLPL4",208,0) S DIR("A")="BILL NUMBER: ",DIR(0)="FAO" "RTN","RCDPLPL4",209,0) S DIR("PRE")="I X=""SUSPENSE"" S X=""^"",RCSUSFLG=1" "RTN","RCDPLPL4",210,0) D ^DIR "RTN","RCDPLPL4",211,0) Q:RCSUSFLG "SUSPENSE" "RTN","RCDPLPL4",212,0) I $D(DTOUT)!$D(DUOUT)!(Y="") Q -1 "RTN","RCDPLPL4",213,0) ; "RTN","RCDPLPL4",214,0) ;Force to all caps "RTN","RCDPLPL4",215,0) S Y=$$UP^XLFSTR(Y) "RTN","RCDPLPL4",216,0) ; "RTN","RCDPLPL4",217,0) ; Check for valid bill number "RTN","RCDPLPL4",218,0) I '$O(^PRCA(430,"D",Y,"")) S Y="" ; Not a valid bill number "RTN","RCDPLPL4",219,0) ; "RTN","RCDPLPL4",220,0) Q:Y="" 0 ; quit if invalid bill number or lookup number "RTN","RCDPLPL4",221,0) ; "RTN","RCDPLPL4",222,0) S X=Y "RTN","RCDPLPL4",223,0) S DA(1)=RCRECTDA "RTN","RCDPLPL4",224,0) D PNORBILL^RCDPURED "RTN","RCDPLPL4",225,0) ; "RTN","RCDPLPL4",226,0) ;if this is an account, is it active? If not, request a new account. "RTN","RCDPLPL4",227,0) I $G(X)[";PRCA" D Q:RCSTAT'="ACTIVE" 0 "RTN","RCDPLPL4",228,0) . S RCSTAT=$$GET1^DIQ(430,$P($G(X),";")_",",8,"E") "RTN","RCDPLPL4",229,0) . I RCSTAT'="ACTIVE",$P($G(^RCD(340,+$P(^PRCA(430,$P($G(X),";"),0),"^",9),0)),"^")[";DPT(" W !,"This bill's status is currently ",RCSTAT,".",!,"Please select a different account." "RTN","RCDPLPL4",230,0) ; "RTN","RCDPLPL4",231,0) ;Something went wrong. Try again. "RTN","RCDPLPL4",232,0) I '$D(X) Q 0 "RTN","RCDPLPL4",233,0) ; "RTN","RCDPLPL4",234,0) ; Account found, return it "RTN","RCDPLPL4",235,0) Q X "RTN","RCDPLPL4",236,0) ; "RTN","RCDPLPL4",237,0) GETAMT(RCACCT,RCAMT) ; Ask the user for the amount "RTN","RCDPLPL4",238,0) ; "RTN","RCDPLPL4",239,0) N X,Y,DTOUT,DUOUT,DIR,DIROUT,DIRUT,DA,RCFLG,AMTFLG "RTN","RCDPLPL4",240,0) ; "RTN","RCDPLPL4",241,0) ; "RTN","RCDPLPL4",242,0) S RCFLG=0 "RTN","RCDPLPL4",243,0) F D Q:RCFLG "RTN","RCDPLPL4",244,0) . S AMTFLG=1 ; Set amount flag check to 1 in case the account is a SUSPENSE account "RTN","RCDPLPL4",245,0) . S DIR("A")="Amount to apply to Account",DIR(0)="N^0.01:"_$J(RCAMT,"",2)_":2" "RTN","RCDPLPL4",246,0) . D ^DIR "RTN","RCDPLPL4",247,0) . I $D(DTOUT)!$D(DUOUT)!(Y="") S Y=-1,RCFLG=1 Q "RTN","RCDPLPL4",248,0) . ;If not a SUSPENSE account, check the balance. "RTN","RCDPLPL4",249,0) . I RCACCT'="" S AMTFLG=$$PAYCHK(RCACCT,Y) "RTN","RCDPLPL4",250,0) . ;amount applied is greater than the amount owed. Try again "RTN","RCDPLPL4",251,0) . Q:'AMTFLG "RTN","RCDPLPL4",252,0) . I +Y>0 S RCFLG=1 Q "RTN","RCDPLPL4",253,0) . S Y=0,RCFLG=1 "RTN","RCDPLPL4",254,0) Q Y "RTN","RCDPLPL4",255,0) ; "RTN","RCDPLPL4",256,0) GETCMT() ; Ask the user for a comment "RTN","RCDPLPL4",257,0) ; "RTN","RCDPLPL4",258,0) N X,Y,DTOUT,DUOUT,DIR,DIROUT,DIRUT "RTN","RCDPLPL4",259,0) F D Q:Y'="" "RTN","RCDPLPL4",260,0) . S Y=$$COM^RCDPECH ; PRCA*4.5*321 "RTN","RCDPLPL4",261,0) . ;strip all leading and trailing spaces "RTN","RCDPLPL4",262,0) . S Y=$$TRIM^XLFSTR(Y) "RTN","RCDPLPL4",263,0) . I Y="" W !,"A comment is required when changing the status of an item in Suspense. Please",!,"try again." Q "RTN","RCDPLPL4",264,0) . I $D(DTOUT) S Y=-1 "RTN","RCDPLPL4",265,0) Q Y "RTN","RCDPLPL4",266,0) ; "RTN","RCDPLPL4",267,0) CONTINUE(RCAMTRM) ; Ask the user to see if they wish to continue "RTN","RCDPLPL4",268,0) ; "RTN","RCDPLPL4",269,0) N X,Y,DTOUT,DUOUT,DIR,DIROUT,DIRUT "RTN","RCDPLPL4",270,0) S DIR("A")="Receipt has $"_$J(RCAMTRM,10,2)_" left to link. Do you wish to link another? ",DIR(0)="YA" "RTN","RCDPLPL4",271,0) D ^DIR "RTN","RCDPLPL4",272,0) I $D(DTOUT)!$D(DUOUT)!(Y="") Q -1 "RTN","RCDPLPL4",273,0) Q Y "RTN","RCDPLPL4",274,0) ; "RTN","RCDPLPL4",275,0) ; Confirm with the user that the wish to stop before completing the linking of payments "RTN","RCDPLPL4",276,0) CONQUIT() ; "RTN","RCDPLPL4",277,0) ; "RTN","RCDPLPL4",278,0) N X,Y,DTOUT,DUOUT,DIR,DIROUT,DIRUT "RTN","RCDPLPL4",279,0) S DIR("A",1)="Exiting now will prevent the linking of any previously selected claims to this" "RTN","RCDPLPL4",280,0) S DIR("A")="receipt. Are you sure? ",DIR(0)="YA" "RTN","RCDPLPL4",281,0) D ^DIR "RTN","RCDPLPL4",282,0) I $D(DTOUT)!$D(DUOUT)!(Y="") Q 1 "RTN","RCDPLPL4",283,0) Q Y "RTN","RCDPLPL4",284,0) ; "RTN","RCDPLPL4",285,0) ;Create a new transaction using an existing transaction as the foundation. "RTN","RCDPLPL4",286,0) COPYTRAN(RCRECTDA,RCTDATA,RCAMT,RCGECSCR) ; "RTN","RCDPLPL4",287,0) ; Input "RTN","RCDPLPL4",288,0) ; RCRECTDA - IEN of Receipt file #344 "RTN","RCDPLPL4",289,0) ; RCPAYDA - IEN of Receipt Transaction file #344.01 "RTN","RCDPLPL4",290,0) ; RCAMT - Amount "RTN","RCDPLPL4",291,0) ; RCGECSCR - null = receipt not processed "RTN","RCDPLPL4",292,0) ; Output "RTN","RCDPLPL4",293,0) ; Update Receipt file #344 and Audit log #344,71 "RTN","RCDPLPL4",294,0) ; "RTN","RCDPLPL4",295,0) N RCNWTRAN,DR,DA,DTOUT,DIE,X,Y,RCTDATA3 "RTN","RCDPLPL4",296,0) ; "RTN","RCDPLPL4",297,0) S RCTDATA3=$G(^RCY(344,RCRECTDA,1,RCTRANDA,3)) "RTN","RCDPLPL4",298,0) ;Create a new transaction "RTN","RCDPLPL4",299,0) S RCNWTRAN=$$ADDTRAN^RCDPURET(RCRECTDA) "RTN","RCDPLPL4",300,0) S RCCMT="Multi-Trans Split" "RTN","RCDPLPL4",301,0) ; "RTN","RCDPLPL4",302,0) ;Update Transaction "RTN","RCDPLPL4",303,0) S DR=".02////"_$P(RCTDATA,U,2) ;Original Confirmation # "RTN","RCDPLPL4",304,0) S DR=DR_";.04///"_RCAMT ;Amount "RTN","RCDPLPL4",305,0) S DR=DR_";.06////"_$P(RCTDATA,U,6) ;Original date of payment "RTN","RCDPLPL4",306,0) S DR=DR_";.07////"_$P(RCTDATA,U,7) ;Original Check # "RTN","RCDPLPL4",307,0) S DR=DR_";.08////"_$P(RCTDATA,U,8) ;Original Check routing # "RTN","RCDPLPL4",308,0) S DR=DR_";.1////"_$P(RCTDATA,U,10) ;Original date on the check "RTN","RCDPLPL4",309,0) S DR=DR_";.11////"_$P(RCTDATA,U,11) ;Original CC number "RTN","RCDPLPL4",310,0) S DR=DR_";.12////"_$P(RCTDATA,U,12) ;Original user who entered the check "RTN","RCDPLPL4",311,0) S DR=DR_";.13////"_$P(RCTDATA,U,13) ;Original check account # "RTN","RCDPLPL4",312,0) S DR=DR_";.14///"_DUZ ;User Linking the payment "RTN","RCDPLPL4",313,0) S DR=DR_";1.02////"_RCCMT ;Initial Comment "RTN","RCDPLPL4",314,0) S DR=DR_";3.02////"_$P(RCTDATA3,U,2) ;Date Trans. originally suspense "RTN","RCDPLPL4",315,0) S DR=DR_";3.03////"_$P(RCTDATA3,U,3) ;User who originally suspended Trans. "RTN","RCDPLPL4",316,0) S DIE="^RCY(344,"_RCRECTDA_",1," "RTN","RCDPLPL4",317,0) S DA=RCNWTRAN,DA(1)=RCRECTDA "RTN","RCDPLPL4",318,0) D ^DIE "RTN","RCDPLPL4",319,0) S $P(^RCY(344,RCRECTDA,1,RCNWTRAN,0),"^",19)=$G(RCDPTYPE) "RTN","RCDPLPL4",320,0) ; "RTN","RCDPLPL4",321,0) ;Update the Audit Log "RTN","RCDPLPL4",322,0) I $G(RCGECSCR)'="" D AUDIT^RCBEPAY(RCRECTDA,RCNWTRAN,"I") "RTN","RCDPLPL4",323,0) ; "RTN","RCDPLPL4",324,0) Q RCNWTRAN "RTN","RCDPLPL4",325,0) ; "RTN","RCDPLPL4",326,0) ;Adjust the original transaction's payment amount to match to the actual, split amount. "RTN","RCDPLPL4",327,0) ADJTRAMT(RCRECTDA,RCTRANDA,RCAMT,RCGECSCR,RCARRAY) ; Added RCARRAY - PRCA*4.5*326 "RTN","RCDPLPL4",328,0) ; Input "RTN","RCDPLPL4",329,0) ; RCRECTDA - IEN of Receipt file #344 "RTN","RCDPLPL4",330,0) ; RCPAYDA - IEN of Receipt Transaction file #344.01 "RTN","RCDPLPL4",331,0) ; RCAMT - Amount "RTN","RCDPLPL4",332,0) ; RCGECSCR - null = receipt not processed "RTN","RCDPLPL4",333,0) ; RCARRAY - Array of Multi-Trans split information (OPTIONAL) "RTN","RCDPLPL4",334,0) ; Output "RTN","RCDPLPL4",335,0) ; Update Receipt file #344 and Audit log #344,71 "RTN","RCDPLPL4",336,0) ; "RTN","RCDPLPL4",337,0) N RCCMT,DR,DIE,DA,DTOUT "RTN","RCDPLPL4",338,0) S RCCMT="Multi-Trans Split" "RTN","RCDPLPL4",339,0) ; "RTN","RCDPLPL4",340,0) S DR=".04///"_RCAMT_";1.02///"_RCCMT "RTN","RCDPLPL4",341,0) S DIE="^RCY(344,"_RCRECTDA_",1," "RTN","RCDPLPL4",342,0) S DA=RCTRANDA,DA(1)=RCRECTDA "RTN","RCDPLPL4",343,0) D ^DIE "RTN","RCDPLPL4",344,0) D LASTEDIT^RCDPUREC(RCRECTDA) "RTN","RCDPLPL4",345,0) ; "RTN","RCDPLPL4",346,0) ;Update the Audit Log "RTN","RCDPLPL4",347,0) I $G(RCGECSCR)'="" D AUDIT^RCBEPAY(RCRECTDA,RCTRANDA,"I",.RCARRAY) ; Added RCARRAY - PRCA*4.5*326 "RTN","RCDPLPL4",348,0) ;Update comment history - PRCA*4.5*321 "RTN","RCDPLPL4",349,0) D AUDIT^RCDPECH(RCRECTDA,RCTRANDA,"","") "RTN","RCDPLPL4",350,0) Q "RTN","RCDPLPL4",351,0) ; "RTN","RCDPLPL4",352,0) ;Link the Transaction to an existing account "RTN","RCDPLPL4",353,0) LINKPAY(RCRECTDA,RCTRANDA,RCACCT) ; "RTN","RCDPLPL4",354,0) ; "RTN","RCDPLPL4",355,0) N DR,DIE,DA,DTOUT "RTN","RCDPLPL4",356,0) S DR=".09///"_RCACCT "RTN","RCDPLPL4",357,0) S DIE="^RCY(344,"_RCRECTDA_",1," "RTN","RCDPLPL4",358,0) S DA=RCTRANDA,DA(1)=RCRECTDA "RTN","RCDPLPL4",359,0) D ^DIE "RTN","RCDPLPL4",360,0) D LASTEDIT^RCDPUREC(RCRECTDA) "RTN","RCDPLPL4",361,0) Q "RTN","RCDPLPL4",362,0) ; "RTN","RCDPLPL4",363,0) ;Remove the suspense comment, item no longer in suspense "RTN","RCDPLPL4",364,0) REMCMT(RCRECTDA,RCTRANDA) ; "RTN","RCDPLPL4",365,0) ; "RTN","RCDPLPL4",366,0) N DR,DIE,DA,DTOUT "RTN","RCDPLPL4",367,0) S DR="1.02///@" "RTN","RCDPLPL4",368,0) S DIE="^RCY(344,"_RCRECTDA_",1," "RTN","RCDPLPL4",369,0) S DA=RCTRANDA,DA(1)=RCRECTDA "RTN","RCDPLPL4",370,0) D ^DIE "RTN","RCDPLPL4",371,0) D LASTEDIT^RCDPUREC(RCRECTDA) "RTN","RCDPLPL4",372,0) Q "RTN","RCDPLPL4",373,0) ; "RTN","RCDPLPL4",374,0) GETACTNM(RCACCT) ; "RTN","RCDPLPL4",375,0) N RCACCTL,RCIEN,RCFILE "RTN","RCDPLPL4",376,0) S RCACCTL="" "RTN","RCDPLPL4",377,0) Q:RCACCT="" RCACCTL "RTN","RCDPLPL4",378,0) S RCFILE=$S(RCACCT[";PRCA(430":430,1:2) "RTN","RCDPLPL4",379,0) S RCIEN=$P(RCACCT,";") "RTN","RCDPLPL4",380,0) S RCACCTL=$$GET1^DIQ(RCFILE,RCIEN_",",".01","E") "RTN","RCDPLPL4",381,0) S:$L(RCACCTL,"-")>1 RCACCTL=$P(RCACCTL,"-",2) "RTN","RCDPLPL4",382,0) Q RCACCTL "RTN","RCDPLPL4",383,0) ; "RTN","RCDPLPL4",384,0) ;Update the suspense comment "RTN","RCDPLPL4",385,0) UPDCMT(RCRECTDA,RCTRANDA,RCCMT) ; "RTN","RCDPLPL4",386,0) ; "RTN","RCDPLPL4",387,0) N DR,DIE,DA,DTOUT "RTN","RCDPLPL4",388,0) S DR="1.02///"_RCCMT_";" S DIE="^RCY(344,"_RCRECTDA_",1," "RTN","RCDPLPL4",389,0) S DA=RCTRANDA,DA(1)=RCRECTDA "RTN","RCDPLPL4",390,0) D ^DIE "RTN","RCDPLPL4",391,0) ;Update comment history - PRCA*4.5*321 "RTN","RCDPLPL4",392,0) D AUDIT^RCDPECH(RCRECTDA,RCTRANDA,"","") "RTN","RCDPLPL4",393,0) Q "RTN","RCDPLPL4",394,0) ; "RTN","RCDPLPL4",395,0) ;Process and update the payment amounts "RTN","RCDPLPL4",396,0) ;Note: some of the code and logic below is also in tag PROCESS^RCDPLPL3. "RTN","RCDPLPL4",397,0) ; If changes in logic are made below, please review this tag as well. "RTN","RCDPLPL4",398,0) PROCESS(RCRECTDA,RCTRANDA,RCTDNM) ; "RTN","RCDPLPL4",399,0) ; "RTN","RCDPLPL4",400,0) N RCERROR "RTN","RCDPLPL4",401,0) S RCERROR=$$PROCESS^RCBEPAY(RCRECTDA,RCTRANDA) "RTN","RCDPLPL4",402,0) ; an error occurred during processing a payment "RTN","RCDPLPL4",403,0) I RCERROR D Q "RTN","RCDPLPL4",404,0) . W ! "RTN","RCDPLPL4",405,0) . W !,"+------------------------------------------------------------------------------+" "RTN","RCDPLPL4",406,0) . W !,"| An ERROR has occurred when processing payment ",RCTRANDA," on receipt ",$P(^RCY(344,RCRECTDA,0),"^"),".",?79,"|" "RTN","RCDPLPL4",407,0) . W !,"| The error message returned during processing is:",?79,"|" "RTN","RCDPLPL4",408,0) . W !,"|",?79,"|" "RTN","RCDPLPL4",409,0) . W !,"| ",$P(RCERROR,"^",2),?79,"|" "RTN","RCDPLPL4",410,0) . W !,"|",?79,"|" "RTN","RCDPLPL4",411,0) . W !,"| You will need to correct the error before you can link the payment.",?79,"|" "RTN","RCDPLPL4",412,0) . W !,"+------------------------------------------------------------------------------+" "RTN","RCDPLPL4",413,0) . W ! "RTN","RCDPLPL4",414,0) . D DELEACCT^RCDPURET(RCRECTDA,RCTRANDA) "RTN","RCDPLPL4",415,0) . W !,"Account "_RCTDNM_" was deleted and not linked." "RTN","RCDPLPL4",416,0) ; "RTN","RCDPLPL4",417,0) ;File entry in Audit Log "RTN","RCDPLPL4",418,0) D AUDIT^RCBEPAY(RCRECTDA,RCTRANDA,"P") "RTN","RCDPLPL4",419,0) ; "RTN","RCDPLPL4",420,0) ; Update Suspense Status "RTN","RCDPLPL4",421,0) D SUSPDIS^RCBEPAY(RCRECTDA,RCTRANDA,"PD") "RTN","RCDPLPL4",422,0) ; "RTN","RCDPLPL4",423,0) I $E(RCSTATUS)="A" D "RTN","RCDPLPL4",424,0) . ; send mail message to the RCDP PAYMENTS mail group "RTN","RCDPLPL4",425,0) . D MAILMSG^RCDPLPSR(RCRECTDA,RCTRANDA) "RTN","RCDPLPL4",426,0) . ; place an x in the fms doc field so it will show on the "RTN","RCDPLPL4",427,0) . ; suspense report "RTN","RCDPLPL4",428,0) . D EDITFMS^RCDPURET(RCRECTDA,RCTRANDA,"x") "RTN","RCDPLPL4",429,0) Q "RTN","RCDPLPL4",430,0) ; "RTN","RCDPLPL4",431,0) ;Display end of processing message. "RTN","RCDPLPL4",432,0) ENDMSG(RCSTATUS) ; "RTN","RCDPLPL4",433,0) ; "RTN","RCDPLPL4",434,0) I $E(RCSTATUS)="A" D "RTN","RCDPLPL4",435,0) . W !,"Since the FMS cash receipt document is Accepted in FMS, you need to go" "RTN","RCDPLPL4",436,0) . W !,"online in FMS and transfer the amount paid out of the station's suspense" "RTN","RCDPLPL4",437,0) . W !,"account.",! "RTN","RCDPLPL4",438,0) . W !,"Mail message(s) sent to RCDP PAYMENTS mail group.",! "RTN","RCDPLPL4",439,0) I $E(RCSTATUS)'="A" D "RTN","RCDPLPL4",440,0) . W !,"Since the FMS cash receipt document is NOT Accepted in FMS, you can use" "RTN","RCDPLPL4",441,0) . W !,"the option Process Receipt located under the Receipt Processing Menu" "RTN","RCDPLPL4",442,0) . W !,"to regenerate the cash receipt document to FMS.",! "RTN","RCDPLPL4",443,0) Q "RTN","RCDPLPL4",444,0) ; "RTN","RCDPLPL4",445,0) ;Get users answers to questions for reports. "RTN","RCDPLPL4",446,0) GETANS(RCIDX) ; "RTN","RCDPLPL4",447,0) N DA,DIR,DTOUT,DUOUT,X,Y,DIRUT,DIROUT "RTN","RCDPLPL4",448,0) ; "RTN","RCDPLPL4",449,0) ; Ask the user what kind of report "RTN","RCDPLPL4",450,0) I RCIDX=1 D "RTN","RCDPLPL4",451,0) . S DIR("?")="Select to Y to review the payments, N to skip the review." "RTN","RCDPLPL4",452,0) . S DIR("A")="Do you want to review the payment list before updating accounts (Y/N)? " "RTN","RCDPLPL4",453,0) ; "RTN","RCDPLPL4",454,0) ; Ask the user for the payer to start the reporting on (Range Option) "RTN","RCDPLPL4",455,0) I RCIDX=2 D "RTN","RCDPLPL4",456,0) . S DIR("?")="Enter Y to update the accounts, N to return to the LP menu" "RTN","RCDPLPL4",457,0) . S DIR("A")="Do you want to update accounts with these payments (Y/N)? " "RTN","RCDPLPL4",458,0) ; "RTN","RCDPLPL4",459,0) S DIR(0)="YA" "RTN","RCDPLPL4",460,0) D ^DIR "RTN","RCDPLPL4",461,0) K DIR "RTN","RCDPLPL4",462,0) I $G(DTOUT)!$G(DUOUT) Q -1 "RTN","RCDPLPL4",463,0) Q Y "RTN","RCDPLPL4",464,0) ; "RTN","RCDPLPL4",465,0) ;Retrieve the review response question from the user "RTN","RCDPLPL4",466,0) GETANS1() ; "RTN","RCDPLPL4",467,0) ; "RTN","RCDPLPL4",468,0) N FLG,X,Y "RTN","RCDPLPL4",469,0) S FLG=0,Y=0 "RTN","RCDPLPL4",470,0) F D Q:FLG=1 "RTN","RCDPLPL4",471,0) . R !,"Do you want to review the payment list before updating accounts (Y/N)? ",X:DTIME "RTN","RCDPLPL4",472,0) . ;I $G(DTOUT) S FLG=1 Q ;If it times out, treat it like a No and go to the next prompt. "RTN","RCDPLPL4",473,0) . I X="" W !,"Enter Y or N to continue." Q "RTN","RCDPLPL4",474,0) . I X["?" W !,"Select to Y to review the payments, N to skip the review." Q "RTN","RCDPLPL4",475,0) . S X=$$UP^XLFSTR(X) "RTN","RCDPLPL4",476,0) . I X="Y" S Y=1,FLG=1 Q "RTN","RCDPLPL4",477,0) . I X="N" S Y=0,FLG=1 Q "RTN","RCDPLPL4",478,0) . W !,"Select to Y to review the payments, N to skip the review." "RTN","RCDPLPL4",479,0) Q Y "RTN","RCDPLPL4",480,0) ; "RTN","RCDPLPL4",481,0) ;Is the amount entered < the amount owed. (AR ACCOUNTS ONLY, NO DEBTORS) "RTN","RCDPLPL4",482,0) PAYCHK(RCACCT,RCAMT) ; "RTN","RCDPLPL4",483,0) ; "RTN","RCDPLPL4",484,0) N OWED,FLG "RTN","RCDPLPL4",485,0) ; "RTN","RCDPLPL4",486,0) S FLG=0 "RTN","RCDPLPL4",487,0) ; account is the debtor account. No need to check... "RTN","RCDPLPL4",488,0) Q:RCACCT'["PRCA" 1 "RTN","RCDPLPL4",489,0) ; calculate amount owed for a bill "RTN","RCDPLPL4",490,0) S OWED=$G(^PRCA(430,+RCACCT,7)) "RTN","RCDPLPL4",491,0) S OWED=$P(OWED,"^")+$P(OWED,"^",2)+$P(OWED,"^",3)+$P(OWED,"^",4)+$P(OWED,"^",5) "RTN","RCDPLPL4",492,0) I RCAMT>OWED W !,"The requested payment is greater than then amount owed please try again.",! Q FLG "RTN","RCDPLPL4",493,0) S FLG=1 "RTN","RCDPLPL4",494,0) Q FLG "RTN","RCDPRLIS") 0^11^B143635402 "RTN","RCDPRLIS",1,0) RCDPRLIS ;WISC/RFJ - list of receipts report ;1 Jun 99 "RTN","RCDPRLIS",2,0) ;;4.5;Accounts Receivable;**114,304,321,332**;Mar 20, 1995;Build 40 "RTN","RCDPRLIS",3,0) ;;Per VA Directive 6402, this routine should not be modified. "RTN","RCDPRLIS",4,0) ; "RTN","RCDPRLIS",5,0) N %ZIS,DATEEND,DATESTRT,POP,RCFILTF,RCFILTT,RCLSTMGR,RCSORT "RTN","RCDPRLIS",6,0) N ZTDESC,ZTQUEUED,ZTRTN,ZTSAVE,ZTSK "RTN","RCDPRLIS",7,0) W ! "RTN","RCDPRLIS",8,0) D DATESEL^RCRJRTRA("RECEIPT Opened") "RTN","RCDPRLIS",9,0) I '$G(DATESTRT)!('$G(DATEEND)) Q "RTN","RCDPRLIS",10,0) ; "RTN","RCDPRLIS",11,0) ; Prompt for sort order PRCA*4.5*321 "RTN","RCDPRLIS",12,0) S RCSORT=$$SORTSEL() "RTN","RCDPRLIS",13,0) I RCSORT=-1 Q "RTN","RCDPRLIS",14,0) ; "RTN","RCDPRLIS",15,0) ; Prompt for filter by FMS Status PRCA*4.5*321 "RTN","RCDPRLIS",16,0) D SELFILTF(.RCFILTF) "RTN","RCDPRLIS",17,0) I RCFILTF=-1 Q "RTN","RCDPRLIS",18,0) ; "RTN","RCDPRLIS",19,0) ; Prompt for filter by Payment Type PRCA*4.5*321 "RTN","RCDPRLIS",20,0) D SELFILTT(.RCFILTT) "RTN","RCDPRLIS",21,0) I RCFILTT=-1 Q "RTN","RCDPRLIS",22,0) ; "RTN","RCDPRLIS",23,0) ; Ask for ListMan display, exit if timeout or '^' "RTN","RCDPRLIS",24,0) W ! "RTN","RCDPRLIS",25,0) S RCLSTMGR=$$ASKLM^RCDPEARL() I RCLSTMGR<0 Q "RTN","RCDPRLIS",26,0) ; "RTN","RCDPRLIS",27,0) ; Send report to Listman if requested "RTN","RCDPRLIS",28,0) I RCLSTMGR D D CLEAN Q "RTN","RCDPRLIS",29,0) . D DQ "RTN","RCDPRLIS",30,0) . D EN^RCDPRL "RTN","RCDPRLIS",31,0) ; "RTN","RCDPRLIS",32,0) ; select device "RTN","RCDPRLIS",33,0) W ! S %ZIS="Q" D ^%ZIS I POP Q "RTN","RCDPRLIS",34,0) I $D(IO("Q")) D D ^%ZTLOAD K IO("Q"),ZTSK Q "RTN","RCDPRLIS",35,0) . S ZTDESC="List of Receipts",ZTRTN="DQ^RCDPRLIS" "RTN","RCDPRLIS",36,0) . S ZTSAVE("DATE*")="",ZTSAVE("RC*")="",ZTSAVE("ZTREQ")="@" "RTN","RCDPRLIS",37,0) W !!,"<*> please wait <*>" "RTN","RCDPRLIS",38,0) D DQ "RTN","RCDPRLIS",39,0) Q "RTN","RCDPRLIS",40,0) ; "RTN","RCDPRLIS",41,0) DQ ; queued report starts here "RTN","RCDPRLIS",42,0) ; PRCA*4.5*321 Extensive changes to this subroutine for filter/sort/ListMan "RTN","RCDPRLIS",43,0) N %,%I,CNT,DATA,DATE,DATEDIS1,DATEDIS2,FMSDOCNO,FMSTATUS,NOW,PAGE,PTYPE,RCDK,RCDPDATA "RTN","RCDPRLIS",44,0) N RCDPFPRE,RCIX,RCRECTDA,RCRJFLAG,RCRJLINE,RCUSER,SCREEN,SPACE,TOTALS,TYPE,X,XX,Y,ZZ ; PRCA*4.5*332 "RTN","RCDPRLIS",45,0) K ^TMP($J,"RCDPRLIS") "RTN","RCDPRLIS",46,0) S SPACE=$J("",80) "RTN","RCDPRLIS",47,0) S RCDK=$$FMADD^XLFDT(DATESTRT,-1)_".24" ; Initialize start date for first $ORDER "RTN","RCDPRLIS",48,0) S DATEEND=DATEEND_".24" ; Receipt date opened can include time, so compare with midnight on the end date. "RTN","RCDPRLIS",49,0) F S RCDK=$O(^RCY(344,"AO",RCDK)) Q:(RCDK=""!(RCDK>DATEEND)) D ; "RTN","RCDPRLIS",50,0) . S RCRECTDA=0 F S RCRECTDA=$O(^RCY(344,"AO",RCDK,RCRECTDA)) Q:'RCRECTDA D "RTN","RCDPRLIS",51,0) . . K RCDPDATA "RTN","RCDPRLIS",52,0) . . D DIQ344^RCDPRPLM(RCRECTDA,".01:200") "RTN","RCDPRLIS",53,0) . . ; get fms document ^ status ^ pre lockbox patch "RTN","RCDPRLIS",54,0) . . S FMSDOCNO=$$FMSSTAT^RCDPUREC(RCRECTDA) "RTN","RCDPRLIS",55,0) . . ; Apply filter by FMS Status "RTN","RCDPRLIS",56,0) . . S FMSTATUS=$P(FMSDOCNO,"^",2) "RTN","RCDPRLIS",57,0) . . I RCFILTF,FMSTATUS'="",'$D(RCFILTF(FMSTATUS)) Q ; this status not included "RTN","RCDPRLIS",58,0) . . ; Apply filter by Payment Type "RTN","RCDPRLIS",59,0) . . S PTYPE=RCDPDATA(344,RCRECTDA,.04,"E") "RTN","RCDPRLIS",60,0) . . I RCFILTT,PTYPE'="",'$D(RCFILTT(PTYPE)) Q ; this status not included "RTN","RCDPRLIS",61,0) . . ; "RTN","RCDPRLIS",62,0) . . ; compute totals by type "RTN","RCDPRLIS",63,0) . . I RCDPDATA(344,RCRECTDA,.04,"E")="" S RCDPDATA(344,RCRECTDA,.04,"E")="UNKNOWN" "RTN","RCDPRLIS",64,0) . . S $P(TOTALS(PTYPE),"^",1)=$P($G(TOTALS(PTYPE)),"^",1)+RCDPDATA(344,RCRECTDA,101,"E") "RTN","RCDPRLIS",65,0) . . S $P(TOTALS(PTYPE),"^",2)=$P($G(TOTALS(PTYPE)),"^",2)+RCDPDATA(344,RCRECTDA,.15,"E") "RTN","RCDPRLIS",66,0) . . S $P(TOTALS,"^",1)=$P($G(TOTALS),"^",1)+RCDPDATA(344,RCRECTDA,101,"E") "RTN","RCDPRLIS",67,0) . . S $P(TOTALS,"^",2)=$P($G(TOTALS),"^",2)+RCDPDATA(344,RCRECTDA,.15,"E") "RTN","RCDPRLIS",68,0) . . ; "RTN","RCDPRLIS",69,0) . . ; opened by "RTN","RCDPRLIS",70,0) . . I RCDPDATA(344,RCRECTDA,.02,"I")=.5 D ; "RTN","RCDPRLIS",71,0) . . . S RCUSER="ar" "RTN","RCDPRLIS",72,0) . . ; PRCA*4.5*332 Begin modified code block "RTN","RCDPRLIS",73,0) . . E D ; "RTN","RCDPRLIS",74,0) . . . S RCUSER=RCDPDATA(344,RCRECTDA,.02,"E") "RTN","RCDPRLIS",75,0) . . . I RCUSER'="" D "RTN","RCDPRLIS",76,0) . . . . S RCUSER=$E($P(RCUSER,",",1),1,5)_","_$E($P(RCUSER,",",2),1) "RTN","RCDPRLIS",77,0) . . ; "RTN","RCDPRLIS",78,0) . . S DATA=RCDPDATA(344,RCRECTDA,.01,"E") ; Receipt number "RTN","RCDPRLIS",79,0) . . S DATA=DATA_"^"_RCDPDATA(344,RCRECTDA,.03,"I") ; Date opened "RTN","RCDPRLIS",80,0) . . S ZZ=$$TYPE(RCDPDATA(344,RCRECTDA,.04,"E")) ; Payment type "RTN","RCDPRLIS",81,0) . . S DATA=DATA_"^"_ZZ ; Payment type "RTN","RCDPRLIS",82,0) . . S DATA=DATA_"^"_RCUSER ; User initials "RTN","RCDPRLIS",83,0) . . S DATA=DATA_"^"_RCDPDATA(344,RCRECTDA,101,"E") ; Payment count "RTN","RCDPRLIS",84,0) . . S DATA=DATA_"^"_RCDPDATA(344,RCRECTDA,.15,"E") ; Payment amount "RTN","RCDPRLIS",85,0) . . S DATA=DATA_"^"_$S($P(FMSDOCNO,"^",3):"*",1:" ") ; Pre lockbox "RTN","RCDPRLIS",86,0) . . S DATA=DATA_"^"_$P(FMSDOCNO,"^") ; FMS CR document "RTN","RCDPRLIS",87,0) . . S ZZ=$$STATUS($P(FMSDOCNO,"^",2)) ; FMS CR doc status "RTN","RCDPRLIS",88,0) . . ; PRCA*4.5*332 End modified code block "RTN","RCDPRLIS",89,0) . . S DATA=DATA_"^"_ZZ ; FMS CR doc status "RTN","RCDPRLIS",90,0) . . S DATA=DATA_"^"_RCRECTDA ; IEN of file 344 "RTN","RCDPRLIS",91,0) . . ; "RTN","RCDPRLIS",92,0) . . ; Index ^TMP global by user selected sort order "RTN","RCDPRLIS",93,0) . . I RCSORT="D" S RCIX=RCDPDATA(344,RCRECTDA,.03,"I") "RTN","RCDPRLIS",94,0) . . I RCSORT="F" S RCIX=FMSTATUS "RTN","RCDPRLIS",95,0) . . I RCSORT="T" S RCIX=PTYPE "RTN","RCDPRLIS",96,0) . . S ^TMP($J,"RCDPRLIS","SORT",RCIX,RCRECTDA)=DATA "RTN","RCDPRLIS",97,0) ; "RTN","RCDPRLIS",98,0) S Y=$P(DATESTRT,".") S DATEDIS1=$$FMTE^XLFDT(Y,"2DZ") "RTN","RCDPRLIS",99,0) S Y=$P(DATEEND,".") S DATEDIS2=$$FMTE^XLFDT(Y,"2DZ") "RTN","RCDPRLIS",100,0) D NOW^%DTC S Y=% D DD^%DT S NOW=Y "RTN","RCDPRLIS",101,0) S PAGE=1,RCRJLINE="",$P(RCRJLINE,"-",81)="" "RTN","RCDPRLIS",102,0) S SCREEN=0 I '$D(ZTQUEUED),'$G(RCLSTMGR),IO=IO(0),$E(IOST)="C" S SCREEN=1 "RTN","RCDPRLIS",103,0) D HDR ; Compile header in to ^TMP for use in report or ListMan "RTN","RCDPRLIS",104,0) U IO D:'$G(RCLSTMGR) H "RTN","RCDPRLIS",105,0) S CNT=0 "RTN","RCDPRLIS",106,0) S RCIX=0 F S RCIX=$O(^TMP($J,"RCDPRLIS","SORT",RCIX)) Q:RCIX=""!($G(RCRJFLAG)) D "RTN","RCDPRLIS",107,0) . S RCRECTDA=0 F S RCRECTDA=$O(^TMP($J,"RCDPRLIS","SORT",RCIX,RCRECTDA)) Q:'RCRECTDA!($G(RCRJFLAG)) D "RTN","RCDPRLIS",108,0) . . S DATA=^TMP($J,"RCDPRLIS","SORT",RCIX,RCRECTDA) "RTN","RCDPRLIS",109,0) . . S DATE=$P(DATA,"^",2) "RTN","RCDPRLIS",110,0) . . S CNT=CNT+1 "RTN","RCDPRLIS",111,0) . . S XX="" "RTN","RCDPRLIS",112,0) . . I RCLSTMGR S XX=" "_$E(CNT_SPACE,1,4)_" " ; line number (for listman) "RTN","RCDPRLIS",113,0) . . S XX=XX_$$FMTE^XLFDT(DATE,"2ZD")_" " ; date opened "RTN","RCDPRLIS",114,0) . . S XX=XX_$E($P(DATA,"^",1)_SPACE,1,12)_" " ; receipt number "RTN","RCDPRLIS",115,0) . . S XX=XX_$E($P(DATA,"^",3)_SPACE,1,$S(RCLSTMGR:5,1:6))_" " ; payment type PRCA*4.5*332 "RTN","RCDPRLIS",116,0) . . S XX=XX_$E($P(DATA,"^",4)_SPACE,1,7)_" " ; user initials PRCA*4.5*332 "RTN","RCDPRLIS",117,0) . . S XX=XX_$J($P(DATA,"^",5),5) ; payment count "RTN","RCDPRLIS",118,0) . . S XX=XX_$J($P(DATA,"^",6),$S(RCLSTMGR:11,1:13),2)_" " ; payment amount "RTN","RCDPRLIS",119,0) . . S XX=XX_$E($P(DATA,"^",7)_SPACE,1) ; pre lockbox "RTN","RCDPRLIS",120,0) . . S XX=XX_$E($P(DATA,"^",8)_SPACE,1,16)_" " ; fms cr document "RTN","RCDPRLIS",121,0) . . S XX=XX_$E($P(DATA,"^",9),1,6) ; fms cr doc status "RTN","RCDPRLIS",122,0) . . ; "RTN","RCDPRLIS",123,0) . . ; Write line or put it to global "RTN","RCDPRLIS",124,0) . . I '$G(RCLSTMGR) D ; "RTN","RCDPRLIS",125,0) . . . W !,XX "RTN","RCDPRLIS",126,0) . . E D ; "RTN","RCDPRLIS",127,0) . . . S ^TMP($J,"RCDPRLIS",CNT)=XX "RTN","RCDPRLIS",128,0) . . . S ^TMP($J,"RCDPRLIS","IDX",CNT)=$P(DATA,"^",10) ; Cross reference line# vs file 344 DA "RTN","RCDPRLIS",129,0) . . ; "RTN","RCDPRLIS",130,0) . . ; set pre lockbox flag to 1 to show note at end of report "RTN","RCDPRLIS",131,0) . . I $P(DATA,"^",7)="*" S RCDPFPRE=1 "RTN","RCDPRLIS",132,0) . . ; "RTN","RCDPRLIS",133,0) . . I '$G(RCLSTMGR),$Y>(IOSL-6) D:SCREEN PAUSE^RCRJRTR1 Q:$G(RCRJFLAG) D H "RTN","RCDPRLIS",134,0) ; "RTN","RCDPRLIS",135,0) I $G(RCLSTMGR) Q ; PRCA*4.5*321 - Totals don't have a place in a protocol list with actions "RTN","RCDPRLIS",136,0) ; "RTN","RCDPRLIS",137,0) I $G(RCRJFLAG) D CLEAN Q "RTN","RCDPRLIS",138,0) I $G(RCDPFPRE) W !?54,"*CR tied to deposit" "RTN","RCDPRLIS",139,0) W !?33,"------ -----------" "RTN","RCDPRLIS",140,0) W !?33,$J($P($G(TOTALS),"^"),6),$J($P($G(TOTALS),"^",2),13,2) "RTN","RCDPRLIS",141,0) ; "RTN","RCDPRLIS",142,0) ; show totals by type of payment "RTN","RCDPRLIS",143,0) W !!,"TOTALS BY TYPE OF PAYMENT" "RTN","RCDPRLIS",144,0) W !,"-------------------------" "RTN","RCDPRLIS",145,0) S TYPE="" F S TYPE=$O(TOTALS(TYPE)) Q:TYPE=""!($G(RCRJFLAG)) D "RTN","RCDPRLIS",146,0) . W !,TYPE,?33,$J($P(TOTALS(TYPE),"^"),6),$J($P(TOTALS(TYPE),"^",2),13,2) "RTN","RCDPRLIS",147,0) . I $Y>(IOSL-6) D:SCREEN PAUSE^RCRJRTR1 Q:$G(RCRJFLAG) D H "RTN","RCDPRLIS",148,0) ; "RTN","RCDPRLIS",149,0) W !!,"*** END OF REPORT ***",! "RTN","RCDPRLIS",150,0) ; "RTN","RCDPRLIS",151,0) I $G(RCRJFLAG) D CLEAN Q "RTN","RCDPRLIS",152,0) I SCREEN U IO(0) R !,"Press RETURN to continue:",%:DTIME "RTN","RCDPRLIS",153,0) ; "RTN","RCDPRLIS",154,0) I '$G(RCLSTMGR) D CLEAN "RTN","RCDPRLIS",155,0) Q "RTN","RCDPRLIS",156,0) ; "RTN","RCDPRLIS",157,0) TYPE(AREVENT) ; Returns an abbreviated type of the AR EVENT - PRCA*4.5*332 Subroutine added "RTN","RCDPRLIS",158,0) ; Input: AREVENT - External AR Event Type (file 344, field .04) "RTN","RCDPRLIS",159,0) ; Returns: 6 character (max) event type abbreviation "RTN","RCDPRLIS",160,0) I AREVENT="EDI LOCKBOX" Q "EDI" "RTN","RCDPRLIS",161,0) I AREVENT="CASH PAYMENT" Q "CASH" "RTN","RCDPRLIS",162,0) I AREVENT="CHECK/MO PAYMENT" Q "CHECK" "RTN","RCDPRLIS",163,0) I AREVENT="LOCKBOX" Q "LOCKBX" "RTN","RCDPRLIS",164,0) Q $E(AREVENT,1,6) "RTN","RCDPRLIS",165,0) ; "RTN","RCDPRLIS",166,0) STATUS(STATUS) ; Returns an abbreviated status of the FMS Doc Status - PRCA*4.5*332 Subroutine added "RTN","RCDPRLIS",167,0) ; Input: STATUS - 2nd word of the FMS Doc Status "RTN","RCDPRLIS",168,0) ; Returns: 9 character (max) status "RTN","RCDPRLIS",169,0) S STATUS=$P(STATUS," ",1) "RTN","RCDPRLIS",170,0) I STATUS="TRANSMITTED" Q "XMIT" "RTN","RCDPRLIS",171,0) I STATUS="ACCEPTED" Q "ACCEPT" "RTN","RCDPRLIS",172,0) I STATUS="REJECTED" Q "REJECT" "RTN","RCDPRLIS",173,0) I STATUS="NOT" Q "NOTENT" "RTN","RCDPRLIS",174,0) I STATUS="ON" Q "ONLINE" "RTN","RCDPRLIS",175,0) Q STATUS "RTN","RCDPRLIS",176,0) ; "RTN","RCDPRLIS",177,0) CLEAN ; Clean up ^TMP arrays "RTN","RCDPRLIS",178,0) D ^%ZISC "RTN","RCDPRLIS",179,0) K ^TMP($J,"RCDPRLIS") "RTN","RCDPRLIS",180,0) Q "RTN","RCDPRLIS",181,0) ; "RTN","RCDPRLIS",182,0) SORTSEL() ; Select sort order for report, by Date Opened, FMS Status or Payment Type "RTN","RCDPRLIS",183,0) ; Input: None "RTN","RCDPRLIS",184,0) ; Return: Sort Type D - Date, F - FMS Status, T - Payment Type "RTN","RCDPRLIS",185,0) N DIR,X,Y,DUOUT,DTOUT,DIRUT,DIROUT,RCREP "RTN","RCDPRLIS",186,0) W ! "RTN","RCDPRLIS",187,0) S DIR(0)="SOA^D:Date;F:FMS Status;T:Type of payment" "RTN","RCDPRLIS",188,0) S DIR("A")="Sort By (D)ATE OPENED, (F)MS STATUS OR (T)YPE OF PAYMENT: " "RTN","RCDPRLIS",189,0) S DIR("B")="D" "RTN","RCDPRLIS",190,0) S DIR("?",1)="Select the order you wish the receipts to appear in on the report." "RTN","RCDPRLIS",191,0) S DIR("?",2)=" " "RTN","RCDPRLIS",192,0) S DIR("?",3)=" D - Sort by the date the receipt was opened" "RTN","RCDPRLIS",193,0) S DIR("?",4)=" S - Sort by the FMS Status" "RTN","RCDPRLIS",194,0) S DIR("?")=" T - Sort by the Payment Type" "RTN","RCDPRLIS",195,0) D ^DIR "RTN","RCDPRLIS",196,0) I $D(DTOUT)!$D(DUOUT)!(Y="") S RETURN=-1 "RTN","RCDPRLIS",197,0) E S RETURN=Y "RTN","RCDPRLIS",198,0) Q RETURN "RTN","RCDPRLIS",199,0) ; "RTN","RCDPRLIS",200,0) SELFILTF(RETURN) ; Ask if user want to filter by FMS status. If yes get list of status. "RTN","RCDPRLIS",201,0) ; Input: None "RTN","RCDPRLIS",202,0) ; Output: RETURN, passed by reference "RTN","RCDPRLIS",203,0) ; RETURN - 1=Filter by FMS Status, 0=Don't "RTN","RCDPRLIS",204,0) ; RETURN(STATUS) - array of FMS Status to include in the report "RTN","RCDPRLIS",205,0) ; "RTN","RCDPRLIS",206,0) N DIR,DIROUT,DIRUT,DTOUT,DUOUT,J,QUIT,RCODES,RCOUT,X,Y "RTN","RCDPRLIS",207,0) K RETURN "RTN","RCDPRLIS",208,0) S RETURN=0 "RTN","RCDPRLIS",209,0) ; "RTN","RCDPRLIS",210,0) W ! "RTN","RCDPRLIS",211,0) S DIR(0)="YA" "RTN","RCDPRLIS",212,0) S DIR("A")="Filter by FMS Status? (Y/N): " "RTN","RCDPRLIS",213,0) S DIR("B")="NO" "RTN","RCDPRLIS",214,0) S DIR("?",1)="Enter 'Y' or 'Yes' to only show receipts with selected FMS Status" "RTN","RCDPRLIS",215,0) S DIR("?",2)="Enter 'N' or 'No' if you wish to show receipts including all FMS Status" "RTN","RCDPRLIS",216,0) S DIR("?")="If you select yes, you will be prompted for the FMS Status' you wish to include" "RTN","RCDPRLIS",217,0) D ^DIR "RTN","RCDPRLIS",218,0) I $D(DIRUT) S RETURN=-1 Q "RTN","RCDPRLIS",219,0) I Y=0 Q "RTN","RCDPRLIS",220,0) S RETURN=1 "RTN","RCDPRLIS",221,0) ; "RTN","RCDPRLIS",222,0) ; Prompt for status' to be included. Multi-select "RTN","RCDPRLIS",223,0) W ! "RTN","RCDPRLIS",224,0) D FIELD^DID(2100.1,3,"","POINTER","RCOUT") "RTN","RCDPRLIS",225,0) S RCODES=RCOUT("POINTER") "RTN","RCDPRLIS",226,0) ; Add pseudo codes to list for "NOT ENTERED" and "ON LINE ENTRY" returned by FMSSTAT^RCDPUREC "RTN","RCDPRLIS",227,0) I $E(RCODES,$L(RCODES))'=";" S RCODES=RCODES_";" "RTN","RCDPRLIS",228,0) S RCODES=RCODES_"O:ON LINE ENTRY;N:NOT ENTERED" "RTN","RCDPRLIS",229,0) K DIR "RTN","RCDPRLIS",230,0) S DIR(0)="SOA^"_RCODES "RTN","RCDPRLIS",231,0) S DIR("A")="Select an FMS Status to include in the report: " "RTN","RCDPRLIS",232,0) K DIR("?") "RTN","RCDPRLIS",233,0) S DIR("?",1)="Select an FMS Status to show in the report." "RTN","RCDPRLIS",234,0) S DIR("?",2)="You will be prompted multiple times, until you hit ENTER" "RTN","RCDPRLIS",235,0) S DIR("?")="without making a selection." "RTN","RCDPRLIS",236,0) S QUIT=0 "RTN","RCDPRLIS",237,0) F D I QUIT Q "RTN","RCDPRLIS",238,0) . W ! "RTN","RCDPRLIS",239,0) . D ^DIR "RTN","RCDPRLIS",240,0) . I $D(DTOUT)!$D(DUOUT) K RETURN S RETURN=-1,QUIT=1 Q "RTN","RCDPRLIS",241,0) . I Y="" S QUIT=1 Q "RTN","RCDPRLIS",242,0) . S RETURN(Y(0))="" "RTN","RCDPRLIS",243,0) . ; Rebuid DIR(0) to only include codes not yet selected "RTN","RCDPRLIS",244,0) . S DIR(0)=$$BLDS(RCODES,.RETURN) "RTN","RCDPRLIS",245,0) . I $P(DIR(0),"^",2)="" S QUIT=1 ; All status selected so stop prompting. "RTN","RCDPRLIS",246,0) I RETURN=-1 Q "RTN","RCDPRLIS",247,0) ; If no FMS Status' were selected, don't filter by it. "RTN","RCDPRLIS",248,0) I $O(RETURN(""))="" D ; "RTN","RCDPRLIS",249,0) . S RETURN=0 "RTN","RCDPRLIS",250,0) . W !!,"No FMS Status' were selected. All FMS Status' will be shown",! "RTN","RCDPRLIS",251,0) Q "RTN","RCDPRLIS",252,0) ; "RTN","RCDPRLIS",253,0) SELFILTT(RETURN) ; Ask if user want to filter by Payment Type. If yes get list of types. "RTN","RCDPRLIS",254,0) ; Input: None "RTN","RCDPRLIS",255,0) ; Output: RETURN, passed by reference "RTN","RCDPRLIS",256,0) ; RETURN - 1=Filter by FMS Status, 0=Don't "RTN","RCDPRLIS",257,0) ; RETURN(STATUS) - array of FMS Status to include in the report "RTN","RCDPRLIS",258,0) ; "RTN","RCDPRLIS",259,0) N DIR,DIROUT,DIRUT,DTOUT,DUOUT,RCODES,RCIEN,RCNAME,QUIT,X,Y "RTN","RCDPRLIS",260,0) K RETURN "RTN","RCDPRLIS",261,0) S RETURN=0 "RTN","RCDPRLIS",262,0) ; "RTN","RCDPRLIS",263,0) W ! "RTN","RCDPRLIS",264,0) S DIR(0)="YA" "RTN","RCDPRLIS",265,0) S DIR("A")="Filter by Payment Type? (Y/N): " "RTN","RCDPRLIS",266,0) S DIR("B")="NO" "RTN","RCDPRLIS",267,0) S DIR("?",1)="Enter 'Y' or 'Yes' to only show receipts with selected Payment Types" "RTN","RCDPRLIS",268,0) S DIR("?",2)="Enter 'N' or 'No' if you wish to show receipts including all Payment Types" "RTN","RCDPRLIS",269,0) S DIR("?")="If you select yes, you will be prompted for the Payment Types you wish to include" "RTN","RCDPRLIS",270,0) D ^DIR "RTN","RCDPRLIS",271,0) I $D(DIRUT) S RETURN=-1 Q "RTN","RCDPRLIS",272,0) I Y=0 Q "RTN","RCDPRLIS",273,0) S RETURN=1 "RTN","RCDPRLIS",274,0) ; "RTN","RCDPRLIS",275,0) ; Prompt for types to be included. Multi-select "RTN","RCDPRLIS",276,0) W ! "RTN","RCDPRLIS",277,0) K DIR "RTN","RCDPRLIS",278,0) ; Present payment types as a set of codes to streamline user interface/selection/help "RTN","RCDPRLIS",279,0) S (RCODES,RCNAME)="" "RTN","RCDPRLIS",280,0) F S RCNAME=$O(^RC(341.1,"B",RCNAME)) Q:RCNAME="" D ; "RTN","RCDPRLIS",281,0) . S RCIEN=0 F S RCIEN=$O(^RC(341.1,"B",RCNAME,RCIEN)) Q:'RCIEN D ; "RTN","RCDPRLIS",282,0) . . I $$GET1^DIQ(341.1,RCIEN_",",.06,"I")=1 D ; "RTN","RCDPRLIS",283,0) . . . S RCODES=RCODES_":"_$$GET1^DIQ(341.1,RCIEN_",",.01,"E")_";" "RTN","RCDPRLIS",284,0) S DIR(0)="SOA^"_RCODES "RTN","RCDPRLIS",285,0) S DIR("A")="Select a Payment Type to include in the report: " "RTN","RCDPRLIS",286,0) K DIR("?") "RTN","RCDPRLIS",287,0) S DIR("?",1)="Select an Payment Type to include in the report." "RTN","RCDPRLIS",288,0) S DIR("?",2)="You will be prompted multiple times, until you hit ENTER" "RTN","RCDPRLIS",289,0) S DIR("?")="without making a selection." "RTN","RCDPRLIS",290,0) S QUIT=0 "RTN","RCDPRLIS",291,0) F D I QUIT Q "RTN","RCDPRLIS",292,0) . W ! "RTN","RCDPRLIS",293,0) . D ^DIR "RTN","RCDPRLIS",294,0) . I $D(DTOUT)!$D(DUOUT) K RETURN S RETURN=-1,QUIT=1 Q "RTN","RCDPRLIS",295,0) . I $G(Y(0))="" S QUIT=1 Q "RTN","RCDPRLIS",296,0) . S RETURN(Y(0))="" "RTN","RCDPRLIS",297,0) . ; Rebuid DIR(0) to only include codes not yet selected "RTN","RCDPRLIS",298,0) . S DIR(0)=$$BLDS(RCODES,.RETURN) "RTN","RCDPRLIS",299,0) . I $P(DIR(0),"^",2)="" S QUIT=1 ; All status selected so stop prompting. "RTN","RCDPRLIS",300,0) ; "RTN","RCDPRLIS",301,0) I RETURN=-1 Q "RTN","RCDPRLIS",302,0) ; If no payment types were selected, don't filter by it. "RTN","RCDPRLIS",303,0) I $O(RETURN(""))="" D ; "RTN","RCDPRLIS",304,0) . S RETURN=0 "RTN","RCDPRLIS",305,0) . W !!,"No Payment Types were selected. Filter will not be used",! "RTN","RCDPRLIS",306,0) Q "RTN","RCDPRLIS",307,0) ; "RTN","RCDPRLIS",308,0) BLDS(CODES,PICKED) ; Build DIR(0) string taking into account codes already picked. "RTN","RCDPRLIS",309,0) ; Input: CODES - Set of codes string in fileman format e.g. A:Apple;B:Ball; "RTN","RCDPRLIS",310,0) ; PICKED - Array of values already picked, subscripted by external value e.g. PICKED("Apple")="" "RTN","RCDPRLIS",311,0) ; Return: RETURN in DIR(0) format. Set of codes that only includes ones not picked. "RTN","RCDPRLIS",312,0) ; e.g "SAO^B:Ball" "RTN","RCDPRLIS",313,0) ; "RTN","RCDPRLIS",314,0) N RETURN "RTN","RCDPRLIS",315,0) S RETURN="SOA^" "RTN","RCDPRLIS",316,0) F J=1:1:$L(CODES,";") D ; "RTN","RCDPRLIS",317,0) . S X=$P($P(CODES,";",J),":",2) "RTN","RCDPRLIS",318,0) . I X'="",'$D(PICKED(X)) S RETURN=RETURN_$P(CODES,";",J)_";" "RTN","RCDPRLIS",319,0) Q RETURN "RTN","RCDPRLIS",320,0) ; "RTN","RCDPRLIS",321,0) HDR ; Compile header into ^TMP for use in ListMan or report "RTN","RCDPRLIS",322,0) ; Input: None "RTN","RCDPRLIS",323,0) ; Output: Header information in ^TMP($J,"RCDPRLIS","HDR",n) for us in report or ListMan formats "RTN","RCDPRLIS",324,0) N K,XX "RTN","RCDPRLIS",325,0) S ^TMP($J,"RCDPRLIS","HDR",1)="LIST OF RECEIPTS REPORT" "RTN","RCDPRLIS",326,0) S XX=" DATE RANGE : "_DATEDIS1_" TO "_DATEDIS2_" " "RTN","RCDPRLIS",327,0) S XX=XX_"SORT ORDER: "_$S(RCSORT="D":"DATE OPENED",RCSORT="F":"FMS STATUS",1:"PAYMENT TYPE") "RTN","RCDPRLIS",328,0) S ^TMP($J,"RCDPRLIS","HDR",2)=XX "RTN","RCDPRLIS",329,0) ; "RTN","RCDPRLIS",330,0) I 'RCFILTF D ; "RTN","RCDPRLIS",331,0) . S XX="ALL" "RTN","RCDPRLIS",332,0) E D ; "RTN","RCDPRLIS",333,0) . S XX="" "RTN","RCDPRLIS",334,0) . S K="" F S K=$O(RCFILTF(K)) Q:K="" S:XX'="" XX=XX_"; " S XX=XX_K "RTN","RCDPRLIS",335,0) S ^TMP($J,"RCDPRLIS","HDR",3)=" FMS STATUS : "_$S($L(XX)>63:"SELECTED",1:XX) "RTN","RCDPRLIS",336,0) ; "RTN","RCDPRLIS",337,0) I 'RCFILTT D ; "RTN","RCDPRLIS",338,0) . S XX="ALL" "RTN","RCDPRLIS",339,0) E D ; "RTN","RCDPRLIS",340,0) . S XX="" "RTN","RCDPRLIS",341,0) . S K="" F S K=$O(RCFILTT(K)) Q:K="" S:XX'="" XX=XX_"; " S XX=XX_K "RTN","RCDPRLIS",342,0) S ^TMP($J,"RCDPRLIS","HDR",4)=" PAYMENT TYPES: "_$S($L(XX)>63:"SELECTED",1:XX) "RTN","RCDPRLIS",343,0) ; PRCA*4.5*332 "RTN","RCDPRLIS",344,0) S ^TMP($J,"RCDPRLIS","HDR",5)="DATE RECEIPT TYPE USER COUNT AMOUNT FMS CR DOC STATUS" "RTN","RCDPRLIS",345,0) W !,RCRJLINE "RTN","RCDPRLIS",346,0) Q "RTN","RCDPRLIS",347,0) ; "RTN","RCDPRLIS",348,0) H ; header "RTN","RCDPRLIS",349,0) N % "RTN","RCDPRLIS",350,0) S %=NOW_" PAGE "_PAGE,PAGE=PAGE+1 I PAGE'=2!(SCREEN) W @IOF "RTN","RCDPRLIS",351,0) W $C(13),^TMP($J,"RCDPRLIS","HDR",1),?(80-$L(%)),% "RTN","RCDPRLIS",352,0) W !,^TMP($J,"RCDPRLIS","HDR",2) "RTN","RCDPRLIS",353,0) W !,^TMP($J,"RCDPRLIS","HDR",3) "RTN","RCDPRLIS",354,0) W !,^TMP($J,"RCDPRLIS","HDR",4) "RTN","RCDPRLIS",355,0) W !,^TMP($J,"RCDPRLIS","HDR",5) "RTN","RCDPRLIS",356,0) W !,RCRJLINE "RTN","RCDPRLIS",357,0) Q "RTN","RCDPRPL2") 0^38^B57949754 "RTN","RCDPRPL2",1,0) RCDPRPL2 ;WISC/RFJ-receipt profile List Manager options ;1 Nov 2018 13:02:23 "RTN","RCDPRPL2",2,0) ;;4.5;Accounts Receivable;**114,148,173,217,332**;Mar 20, 1995;Build 40 "RTN","RCDPRPL2",3,0) ;Per VA Directive 6402, this routine should not be modified. "RTN","RCDPRPL2",4,0) Q "RTN","RCDPRPL2",5,0) ; "RTN","RCDPRPL2",6,0) ; This routine contains entry points for customization and printing "RTN","RCDPRPL2",7,0) ; "RTN","RCDPRPL2",8,0) ACCTPROF ;EP from protocol RCDP RECEIPT PROFILE ACCOUNT PROFILE "RTN","RCDPRPL2",9,0) ; Account Profile action "RTN","RCDPRPL2",10,0) D FULL^VALM1 "RTN","RCDPRPL2",11,0) S VALMBCK="R" "RTN","RCDPRPL2",12,0) ; "RTN","RCDPRPL2",13,0) N ACCT,RCDEBTDA,RCTRANDA "RTN","RCDPRPL2",14,0) S RCTRANDA=$$SELPAY^RCDPRPL1(RCRECTDA) ; Select payment transaction "RTN","RCDPRPL2",15,0) I RCTRANDA>0 D ; Find debtor (file 340) entry "RTN","RCDPRPL2",16,0) . S RCDEBTDA=0 "RTN","RCDPRPL2",17,0) . S ACCT=$P(^RCY(344,RCRECTDA,1,RCTRANDA,0),U,3) ; (#.03) ACCOUNT [3V] "RTN","RCDPRPL2",18,0) . I ACCT["DPT(" S RCDEBTDA=$O(^RCD(340,"B",ACCT,0)) "RTN","RCDPRPL2",19,0) . I ACCT["PRCA(430," S RCDEBTDA=$P($G(^PRCA(430,+ACCT,0)),U,9) "RTN","RCDPRPL2",20,0) . I 'RCDEBTDA S VALMSG="Account NOT found for payment transaction." "RTN","RCDPRPL2",21,0) ; "RTN","RCDPRPL2",22,0) ; Payment not selected ask to select an account "RTN","RCDPRPL2",23,0) I '$D(RCDEBTDA) S RCDEBTDA=$$SELACCT^RCDPAPLM "RTN","RCDPRPL2",24,0) ; "RTN","RCDPRPL2",25,0) Q:$G(RCDEBTDA)'>0 "RTN","RCDPRPL2",26,0) D EN^VALM("RCDP ACCOUNT PROFILE") "RTN","RCDPRPL2",27,0) S VALMBCK="R" "RTN","RCDPRPL2",28,0) I $G(RCDPFXIT) S VALMBCK="Q" ; Fast exit "RTN","RCDPRPL2",29,0) Q "RTN","RCDPRPL2",30,0) ; "RTN","RCDPRPL2",31,0) PRINRECT ;EP from protocol action RCDP RECEIPT PROFILE PRINT RECEIPT "RTN","RCDPRPL2",32,0) ; Print a receipt "RTN","RCDPRPL2",33,0) D FULL^VALM1 "RTN","RCDPRPL2",34,0) S VALMBCK="R" "RTN","RCDPRPL2",35,0) N RCTRANDA "RTN","RCDPRPL2",36,0) ; "RTN","RCDPRPL2",37,0) ; Select the payment transaction "RTN","RCDPRPL2",38,0) S RCTRANDA=$$SELPAY^RCDPRPL1(RCRECTDA) "RTN","RCDPRPL2",39,0) Q:RCTRANDA<1 "RTN","RCDPRPL2",40,0) ; "RTN","RCDPRPL2",41,0) ; Check if transaction has a payment amount "RTN","RCDPRPL2",42,0) I '$P($G(^RCY(344,RCRECTDA,1,RCTRANDA,0)),U,4) D Q "RTN","RCDPRPL2",43,0) . S VALMSG="NO Payment Amount on Transaction." "RTN","RCDPRPL2",44,0) ; "RTN","RCDPRPL2",45,0) S VALMSG=$$DEVICE^RCDPRECT "RTN","RCDPRPL2",46,0) I VALMSG=0 S VALMSG="Receipt NOT printed" "RTN","RCDPRPL2",47,0) Q "RTN","RCDPRPL2",48,0) ; "RTN","RCDPRPL2",49,0) PRINT215 ;EP from protocol action RCDP RECEIPT PROFILE 215 REPORT "RTN","RCDPRPL2",50,0) ; Print 215 report "RTN","RCDPRPL2",51,0) ; Input: RCRECTDA - IEN of the selected receipt (#344) "RTN","RCDPRPL2",52,0) N %ZIS,POP,RECEIPDA,RCTYPE "RTN","RCDPRPL2",53,0) D FULL^VALM1 "RTN","RCDPRPL2",54,0) S VALMBCK="R",RECEIPDA=RCRECTDA "RTN","RCDPRPL2",55,0) S RCTYPE=$$GETTYPE^RCDPR215 "RTN","RCDPRPL2",56,0) I RCTYPE="" Q "RTN","RCDPRPL2",57,0) ; "RTN","RCDPRPL2",58,0) ; Select device "RTN","RCDPRPL2",59,0) W ! "RTN","RCDPRPL2",60,0) S %ZIS="Q" "RTN","RCDPRPL2",61,0) D ^%ZIS "RTN","RCDPRPL2",62,0) Q:POP "RTN","RCDPRPL2",63,0) I $D(IO("Q")) D D ^%ZTLOAD K IO("Q"),ZTSK D ^%ZISC Q "RTN","RCDPRPL2",64,0) . S ZTDESC="Print 215 Report",ZTRTN="DQ^RCDPR215" "RTN","RCDPRPL2",65,0) . S ZTSAVE("RECEIPDA")="",ZTSAVE("RCTYPE")="",ZTSAVE("ZTREQ")="@" "RTN","RCDPRPL2",66,0) W !!,"<*> please wait <*>" "RTN","RCDPRPL2",67,0) D DQ^RCDPR215 "RTN","RCDPRPL2",68,0) Q "RTN","RCDPRPL2",69,0) ; "RTN","RCDPRPL2",70,0) CUSTOMIZ ;EP from protocol RCDP RECEIPT PROFILE CUSTOMIZE "RTN","RCDPRPL2",71,0) ; Option to customize display and printing of the receipt "RTN","RCDPRPL2",72,0) ; Input: None "RTN","RCDPRPL2",73,0) ; Output: Receipt Profile display and printing options customized "RTN","RCDPRPL2",74,0) N OPT,QUES "RTN","RCDPRPL2",75,0) D FULL^VALM1 "RTN","RCDPRPL2",76,0) S VALMBCK="R" "RTN","RCDPRPL2",77,0) ; "RTN","RCDPRPL2",78,0) W !!,"This option will allow the user to customize the screen and options" "RTN","RCDPRPL2",79,0) W !,"used for receipt processing." "RTN","RCDPRPL2",80,0) ; "RTN","RCDPRPL2",81,0) ; Ask to show check/credit card data "RTN","RCDPRPL2",82,0) S OPT="SHOWCHECK" "RTN","RCDPRPL2",83,0) S QUES=" Do you want to show trace #, check and credit card information" "RTN","RCDPRPL2",84,0) Q:$$ASKCUST(OPT,QUES)=-1 "RTN","RCDPRPL2",85,0) ; "RTN","RCDPRPL2",86,0) ; Ask to show acct lookup, batch and sequence number "RTN","RCDPRPL2",87,0) S OPT="SHOWACCT" "RTN","RCDPRPL2",88,0) S QUES=" Do you want to show acct. lookup, batch and sequence information" "RTN","RCDPRPL2",89,0) I $$ASKCUST(OPT,QUES)=-1 D INIT^RCDPRPLM Q "RTN","RCDPRPL2",90,0) ; "RTN","RCDPRPL2",91,0) ; Ask to show comments "RTN","RCDPRPL2",92,0) S OPT="SHOWCOMMENTS",QUES=" Do you want to show comments" "RTN","RCDPRPL2",93,0) I $$ASKCUST(OPT,QUES)=-1 D INIT^RCDPRPLM Q "RTN","RCDPRPL2",94,0) ; "RTN","RCDPRPL2",95,0) ; Ask to show FMS cr documents "RTN","RCDPRPL2",96,0) S OPT="SHOWFMS" "RTN","RCDPRPL2",97,0) S QUES=" Do you want to show the FMS cash receipt documents" "RTN","RCDPRPL2",98,0) I $$ASKCUST(OPT,QUES)=-1 D INIT^RCDPRPLM Q "RTN","RCDPRPL2",99,0) ; "RTN","RCDPRPL2",100,0) ; Ask to show EOB detail information "RTN","RCDPRPL2",101,0) S OPT="SHOWEOB" "RTN","RCDPRPL2",102,0) S QUES=" Do you want to show electronic EEOB detail data" "RTN","RCDPRPL2",103,0) I $$ASKCUST(OPT,QUES)=-1 D INIT^RCDPRPLM Q "RTN","RCDPRPL2",104,0) ; "RTN","RCDPRPL2",105,0) ; Make sure form is rebuilt based on the answers above "RTN","RCDPRPL2",106,0) D INIT^RCDPRPLM "RTN","RCDPRPL2",107,0) ; "RTN","RCDPRPL2",108,0) W !!,"The next prompts will allow the user to individually set up the way receipts" "RTN","RCDPRPL2",109,0) W !,"should be printed when entering payment transactions. The user can set" "RTN","RCDPRPL2",110,0) W !,"the software up to automatically print a receipt to a device, never print" "RTN","RCDPRPL2",111,0) W !,"the receipt, or ask to print the receipt. The user can also specify the" "RTN","RCDPRPL2",112,0) W !,"printer used for printing receipts, preventing from having to re-enter it." "RTN","RCDPRPL2",113,0) N DEVICE,TYPE "RTN","RCDPRPL2",114,0) ; "RTN","RCDPRPL2",115,0) ; For printing receipts "RTN","RCDPRPL2",116,0) D Q:TYPE<0 "RTN","RCDPRPL2",117,0) . W ! "RTN","RCDPRPL2",118,0) . S TYPE=$$ASKRECT Q:TYPE<0 "RTN","RCDPRPL2",119,0) . ; Never print receipt "RTN","RCDPRPL2",120,0) . I TYPE=0 D RCSET("RECEIPT",0) Q "RTN","RCDPRPL2",121,0) . ; Ask default printer device "RTN","RCDPRPL2",122,0) . S DEVICE=$$ASKDEVIC(1) "RTN","RCDPRPL2",123,0) . ; No default printer, always print receipt "RTN","RCDPRPL2",124,0) . I DEVICE="",TYPE=1 D Q "RTN","RCDPRPL2",125,0) .. W !,"Since you did not enter a default printer for printing receipts," "RTN","RCDPRPL2",126,0) .. W !,"I will change it so the software will ask you to print the receipt" "RTN","RCDPRPL2",127,0) .. W !,"when entering a payment transaction." "RTN","RCDPRPL2",128,0) .. D RCSET("RECEIPT",2) "RTN","RCDPRPL2",129,0) . ; Set default printer for receipts "RTN","RCDPRPL2",130,0) . D RCSET("RECEIPT",TYPE_U_DEVICE) "RTN","RCDPRPL2",131,0) ; "RTN","RCDPRPL2",132,0) ; For printing 215 report "RTN","RCDPRPL2",133,0) W !!!,"You now have the option of setting up the default printer for automatically" "RTN","RCDPRPL2",134,0) W !,"printing the 215 report when a receipt is processed.",! "RTN","RCDPRPL2",135,0) ; Ask default printer device "RTN","RCDPRPL2",136,0) S DEVICE=$$ASKDEVIC(2) "RTN","RCDPRPL2",137,0) D RCSET("215REPORT",U_DEVICE) "RTN","RCDPRPL2",138,0) Q "RTN","RCDPRPL2",139,0) ; "RTN","RCDPRPL2",140,0) RCSET(RCSNPT,RCSLDV) ; File the selected parameter & device as the user's preference "RTN","RCDPRPL2",141,0) ; RCSNPT - Name of the user's preference parameter to file "RTN","RCDPRPL2",142,0) ; RCSLDV - User's preference^Name of the device selected by the user "RTN","RCDPRPL2",143,0) N DA,DIC,DIE,DR,X,Y "RTN","RCDPRPL2",144,0) ; "RTN","RCDPRPL2",145,0) ; If this is a new parameter, file it "RTN","RCDPRPL2",146,0) I '$D(^RC(342.3,"B",RCSNPT)) D "RTN","RCDPRPL2",147,0) . K DD,DO,DIC("DR") "RTN","RCDPRPL2",148,0) . S DIC="^RC(342.3,",DIC(0)="",X=RCSNPT "RTN","RCDPRPL2",149,0) . D FILE^DICN "RTN","RCDPRPL2",150,0) ; "RTN","RCDPRPL2",151,0) ; File user's preference for the parameter if they don't have one currently defined "RTN","RCDPRPL2",152,0) S DA(1)=$O(^RC(342.3,"B",RCSNPT,0)) "RTN","RCDPRPL2",153,0) I '$D(^RC(342.3,DA(1),1,"B",DUZ)) D Q "RTN","RCDPRPL2",154,0) . S DIC(0)="",DIC("P")=$P(^DD(342.3,1,0),U,2),DIC="^RC(342.3,"_DA(1)_",1,",X=DUZ "RTN","RCDPRPL2",155,0) . S DIC("DR")="1////"_$P(RCSLDV,U,1)_";2////"_$P(RCSLDV,U,2) "RTN","RCDPRPL2",156,0) . K DD,DO "RTN","RCDPRPL2",157,0) . D FILE^DICN "RTN","RCDPRPL2",158,0) ; "RTN","RCDPRPL2",159,0) ; Edit the user's preference for the parameter "RTN","RCDPRPL2",160,0) S DA=$O(^RC(342.3,DA(1),1,"B",DUZ,0)) "RTN","RCDPRPL2",161,0) S DR=".01////"_DUZ_";1////"_$P(RCSLDV,U)_";2////"_$P(RCSLDV,U,2) "RTN","RCDPRPL2",162,0) S DIE="^RC(342.3,"_DA(1)_",1," "RTN","RCDPRPL2",163,0) D ^DIE "RTN","RCDPRPL2",164,0) Q "RTN","RCDPRPL2",165,0) ; "RTN","RCDPRPL2",166,0) OPTCK(RCSNPT,RCSLDV) ; function, return user's preference for AR USER CUSTOMIZE parameter (if defined) "RTN","RCDPRPL2",167,0) ; Input: RCSNPT - Name of the AR USER CUSTOMIZE (#342.3) parameter to check "RTN","RCDPRPL2",168,0) ; RCLSDV - Piece to be retrieved off of the 342.3 record "RTN","RCDPRPL2",169,0) ; Returns: user's preference for RCSNPT or null if no preference in file "RTN","RCDPRPL2",170,0) N RCDA "RTN","RCDPRPL2",171,0) ; "RTN","RCDPRPL2",172,0) ; find user preference IEN for the specified entry (if any) "RTN","RCDPRPL2",173,0) S RCDA=$O(^RC(342.3,+$O(^RC(342.3,"B",RCSNPT,0)),1,"B",DUZ,0)) "RTN","RCDPRPL2",174,0) ; "RTN","RCDPRPL2",175,0) ; If the user has a preference retrieve it "RTN","RCDPRPL2",176,0) I RCDA S RCDA=$P($G(^RC(342.3,+$O(^RC(342.3,"B",RCSNPT,0)),1,RCDA,0)),U,RCSLDV) "RTN","RCDPRPL2",177,0) Q RCDA "RTN","RCDPRPL2",178,0) ; "RTN","RCDPRPL2",179,0) ASKCUST(OPT,QUES) ; Ask one of the customize questions from the CUSTOMIZ action "RTN","RCDPRPL2",180,0) ; Input: OPT - Name of customize option to set "RTN","RCDPRPL2",181,0) ; QUES - Question for the user "RTN","RCDPRPL2",182,0) ; Returns: 1 if answer 'YES', 0 if answer 'NO', -1 if timed out or '^' "RTN","RCDPRPL2",183,0) N DIR,DTOUT,DUOUT,X,Y "RTN","RCDPRPL2",184,0) S DIR(0)="YO" "RTN","RCDPRPL2",185,0) S DIR("B")="NO" "RTN","RCDPRPL2",186,0) S:$$OPTCK(OPT,2) DIR("B")="YES" "RTN","RCDPRPL2",187,0) S DIR("A")=QUES "RTN","RCDPRPL2",188,0) W ! "RTN","RCDPRPL2",189,0) D ^DIR "RTN","RCDPRPL2",190,0) I $G(DTOUT)!($G(DUOUT)) S Y=-1 "RTN","RCDPRPL2",191,0) I Y'=-1 D RCSET(OPT,Y) ; PRCA*4.5*332, fixed OPT parameter "RTN","RCDPRPL2",192,0) Q Y "RTN","RCDPRPL2",193,0) ; "RTN","RCDPRPL2",194,0) ASKRECT() ; function, ask user when they want to print the receipt "RTN","RCDPRPL2",195,0) ; Returns: 0 (never), 1 (always), 2 (ask), -1 (timed out or '^') "RTN","RCDPRPL2",196,0) N DEFAULT,DIR,DTOUT,DUOUT,X,Y "RTN","RCDPRPL2",197,0) S DEFAULT="ALWAYS" "RTN","RCDPRPL2",198,0) I $$OPTCK("RECEIPT",2)'=""!($$OPTCK("RECEIPT",3)'="") D "RTN","RCDPRPL2",199,0) . S DEFAULT=$$OPTCK("RECEIPT",2),DEFAULT=$S(DEFAULT=0:"NEVER",DEFAULT=1:"ALWAYS",1:"MAYBE") "RTN","RCDPRPL2",200,0) S DIR(0)="SO^0:Never Print the Receipt;1:Always Print the Receipt;2:Maybe, Ask to Print the Receipt" "RTN","RCDPRPL2",201,0) S DIR("A")="Print Receipt" "RTN","RCDPRPL2",202,0) S DIR("B")=DEFAULT "RTN","RCDPRPL2",203,0) D ^DIR "RTN","RCDPRPL2",204,0) I $G(DTOUT)!($G(DUOUT)) S Y=-1 "RTN","RCDPRPL2",205,0) Q Y "RTN","RCDPRPL2",206,0) ; "RTN","RCDPRPL2",207,0) ASKDEVIC(RCTYPE) ; Ask for the default printer for receipts and for 215 report "RTN","RCDPRPL2",208,0) ; Input: RCTYPE - 1 for receipts, 2 for 215 report "RTN","RCDPRPL2",209,0) ; Returns: Name of selected device or "" "RTN","RCDPRPL2",210,0) N RCION "RTN","RCDPRPL2",211,0) S %ZIS="NP0" "RTN","RCDPRPL2",212,0) S %ZIS("A")="Enter the Default Printer for Printing Receipts: " "RTN","RCDPRPL2",213,0) I RCTYPE=2 S %ZIS("A")="Enter the Default Printer for Printing the 215 Report: " "RTN","RCDPRPL2",214,0) S %ZIS("B")="" "RTN","RCDPRPL2",215,0) I RCTYPE=1,$$OPTCK("RECEIPT",3)'="" S %ZIS("B")=$$OPTCK("RECEIPT",3) "RTN","RCDPRPL2",216,0) I RCTYPE=2,$$OPTCK("215REPORT",3)'="" S %ZIS("B")=$$OPTCK("215REPORT",3) "RTN","RCDPRPL2",217,0) D ^%ZIS "RTN","RCDPRPL2",218,0) I IO=IO(0) W !,"You cannot select your current device as a default printer." Q "" "RTN","RCDPRPL2",219,0) S RCION=ION "RTN","RCDPRPL2",220,0) ; "RTN","RCDPRPL2",221,0) ; close device "RTN","RCDPRPL2",222,0) D ^%ZISC "RTN","RCDPRPL2",223,0) Q RCION "RTN","RCDPRPL2",224,0) ; "RTN","RCDPRPL2",225,0) SHEOB ; Show EEOB detail if switch on - moved from RCDPRPLM "RTN","RCDPRPL2",226,0) ; Input: RCLINE - Current line count "RTN","RCDPRPL2",227,0) ; Output: RCLINE - Updated line countt "RTN","RCDPRPL2",228,0) I $$OPTCK("SHOWEOB",2) D "RTN","RCDPRPL2",229,0) . N Z S Z=$O(^RCY(344.4,"ARCT",RCRECTDA,0)) Q:'Z "RTN","RCDPRPL2",230,0) . S RCLINE=RCLINE+1 "RTN","RCDPRPL2",231,0) . D SET^RCDPRPLM(" ",RCLINE,1,80) "RTN","RCDPRPL2",232,0) . S RCLINE=RCLINE+1 "RTN","RCDPRPL2",233,0) . D SET^RCDPRPLM("EEOB Detail:",RCLINE,1,80,0,IOUON,IOUOFF) "RTN","RCDPRPL2",234,0) . K ^TMP($J,"RCDISP") "RTN","RCDPRPL2",235,0) . D DISP^RCDPEDS(Z) ; build ^TMP($J,"RCDISP") "RTN","RCDPRPL2",236,0) . S Z=0 F S Z=$O(^TMP($J,"RCDISP",Z)) Q:'Z D "RTN","RCDPRPL2",237,0) .. S RCLINE=RCLINE+1 "RTN","RCDPRPL2",238,0) .. D SET^RCDPRPLM(^TMP($J,"RCDISP",Z),RCLINE,1,80) "RTN","RCDPRPL2",239,0) . K ^TMP($J,"RCDISP") "RTN","RCDPRPL2",240,0) Q "RTN","RCDPRPL2",241,0) ; "RTN","RCDPRPL4") 0^32^B36707329 "RTN","RCDPRPL4",1,0) RCDPRPL4 ;WISC/RFJ/PJH-receipt profile listmanager options ;1 Apr 01 "RTN","RCDPRPL4",2,0) ;;4.5;Accounts Receivable;**169,172,173,269,276,326,332**;Mar 20, 1995;Build 40 "RTN","RCDPRPL4",3,0) ;;Per VA Directive 6402, this routine should not be modified. "RTN","RCDPRPL4",4,0) Q "RTN","RCDPRPL4",5,0) ; "RTN","RCDPRPL4",6,0) ; this routine contains the entry points for receipt management "RTN","RCDPRPL4",7,0) ; "RTN","RCDPRPL4",8,0) ; "RTN","RCDPRPL4",9,0) ONLINE ; allow the supervisor to mark the CR document as input on line "RTN","RCDPRPL4",10,0) ; "RTN","RCDPRPL4",11,0) ; Input - RCRECDA - IEN of CR receipt in #344 "RTN","RCDPRPL4",12,0) ; "RTN","RCDPRPL4",13,0) D FULL^VALM1 "RTN","RCDPRPL4",14,0) S VALMBCK="R" "RTN","RCDPRPL4",15,0) ; "RTN","RCDPRPL4",16,0) ; get fms document and status "RTN","RCDPRPL4",17,0) N %,FMSDOC,GECSDATA "RTN","RCDPRPL4",18,0) S FMSDOC=$$FMSSTAT^RCDPUREC(RCRECTDA) "RTN","RCDPRPL4",19,0) ; "RTN","RCDPRPL4",20,0) W !!,"This option will allow you to mark a rejected Cash Receipt document as" "RTN","RCDPRPL4",21,0) W !,"entered on line. This will prevent the document from being listed on" "RTN","RCDPRPL4",22,0) W !,"the nightly mailman message used to help manage the receipts and deposits." "RTN","RCDPRPL4",23,0) ; "RTN","RCDPRPL4",24,0) W !!,"FMS Cash Receipt Document: ",$P(FMSDOC,"^"),?48,"Status: ",$P(FMSDOC,"^",2) "RTN","RCDPRPL4",25,0) ; "RTN","RCDPRPL4",26,0) I '$D(^XUSEC("PRCAY PAYMENT SUP",DUZ)) W !!,"You are not an owner of the supervisor PRCAY PAYMENT SUP security key." D QUIT Q "RTN","RCDPRPL4",27,0) ; "RTN","RCDPRPL4",28,0) ; cr accepted "RTN","RCDPRPL4",29,0) I $E($P(FMSDOC,"^",2))="A" W !!,"You CANNOT mark the Cash Receipt document as entered on line.",!,"The CR document is ACCEPTED ??" D QUIT Q "RTN","RCDPRPL4",30,0) ; "RTN","RCDPRPL4",31,0) ; not been transmitted for 2 days "RTN","RCDPRPL4",32,0) I $E($P(FMSDOC,"^",2))="T",$$FMDIFF^XLFDT(DT,$P(^RCY(344,RCRECTDA,0),"^",8))'>2 W !!,"You CANNOT mark the Cash Receipt document as entered on line.",!,"The CR document has NOT been TRANSMITTED for 2 days ??" D QUIT Q "RTN","RCDPRPL4",33,0) ; "RTN","RCDPRPL4",34,0) ; cr queued for transmission "RTN","RCDPRPL4",35,0) I $E($P(FMSDOC,"^",2))="Q"!($E($P(FMSDOC,"^",2))="M") W !!,"You CANNOT mark the Cash Receipt document as entered on line.",!,"The CR document is waiting to be TRANSMITTED ??" D QUIT Q "RTN","RCDPRPL4",36,0) ; "RTN","RCDPRPL4",37,0) ; check to see if already marked as entered on line "RTN","RCDPRPL4",38,0) I $E($P(FMSDOC,"^",2))="O" D Q "RTN","RCDPRPL4",39,0) . I $$ASKSTAT("REMOVE")'=1 Q "RTN","RCDPRPL4",40,0) . W !,"... removing CR status as entered on line ..." "RTN","RCDPRPL4",41,0) . ; remove the ON-LINE status on field 201 "RTN","RCDPRPL4",42,0) . D EDITREC^RCDPUREC(RCRECTDA,"201///0") "RTN","RCDPRPL4",43,0) . ; show the new status "RTN","RCDPRPL4",44,0) . S FMSDOC=$$FMSSTAT^RCDPUREC(RCRECTDA) "RTN","RCDPRPL4",45,0) . W !!,"FMS Cash Receipt Document: ",$P(FMSDOC,"^"),?48,"Status: ",$P(FMSDOC,"^",2) "RTN","RCDPRPL4",46,0) . D QUIT "RTN","RCDPRPL4",47,0) ; "RTN","RCDPRPL4",48,0) ; ask to change the status to entered on line "RTN","RCDPRPL4",49,0) I $$ASKSTAT("ENTER")'=1 D QUIT Q "RTN","RCDPRPL4",50,0) ; "RTN","RCDPRPL4",51,0) ; change the status to entered on line "RTN","RCDPRPL4",52,0) W !!,"... changing status to entered on line ..." "RTN","RCDPRPL4",53,0) W !,"... changing the generic code sheet stack file status to ACCEPTED ..." "RTN","RCDPRPL4",54,0) ; "RTN","RCDPRPL4",55,0) ; set the status to entered on line in field 201 "RTN","RCDPRPL4",56,0) D EDITREC^RCDPUREC(RCRECTDA,"201///1") "RTN","RCDPRPL4",57,0) ; "RTN","RCDPRPL4",58,0) ; set the generic code sheet status as accepted "RTN","RCDPRPL4",59,0) ; get the document ien "RTN","RCDPRPL4",60,0) D DATA^GECSSGET($P(FMSDOC,"^")) "RTN","RCDPRPL4",61,0) I $G(GECSDATA) D SETSTAT^GECSSTAA(GECSDATA,"A") "RTN","RCDPRPL4",62,0) ; "RTN","RCDPRPL4",63,0) ; show the new status "RTN","RCDPRPL4",64,0) S FMSDOC=$$FMSSTAT^RCDPUREC(RCRECTDA) "RTN","RCDPRPL4",65,0) W !!,"FMS Cash Receipt Document: ",$P(FMSDOC,"^"),?48,"Status: ",$P(FMSDOC,"^",2) "RTN","RCDPRPL4",66,0) ; "RTN","RCDPRPL4",67,0) QUIT ; pause and rebuild the header "RTN","RCDPRPL4",68,0) W !!,"press RETURN to continue: " "RTN","RCDPRPL4",69,0) R %:DTIME "RTN","RCDPRPL4",70,0) D HDR^RCDPRPLM "RTN","RCDPRPL4",71,0) Q "RTN","RCDPRPL4",72,0) ; "RTN","RCDPRPL4",73,0) ; "RTN","RCDPRPL4",74,0) ASKSTAT(ACTION) ; ask if its okay to remove or change the entered online status "RTN","RCDPRPL4",75,0) ; 1 is yes, otherwise no "RTN","RCDPRPL4",76,0) N DIR,DIQ2,DTOUT,DUOUT,X,Y "RTN","RCDPRPL4",77,0) S DIR(0)="YO",DIR("B")="NO" "RTN","RCDPRPL4",78,0) S DIR("A",1)=" Do you want to "_ACTION_" the status showing the Cash Receipt" "RTN","RCDPRPL4",79,0) S DIR("A")=" document was entered ON LINE" "RTN","RCDPRPL4",80,0) D ^DIR "RTN","RCDPRPL4",81,0) I $G(DTOUT)!($G(DUOUT)) S Y=-1 "RTN","RCDPRPL4",82,0) Q Y "RTN","RCDPRPL4",83,0) ; "RTN","RCDPRPL4",84,0) ERAWL(RCSCR) ; Generate automatic dec adj from ERA Worklist in RCSCR "RTN","RCDPRPL4",85,0) ; RCADJ returned = 1 if passed by reference and adjustment successful "RTN","RCDPRPL4",86,0) ; returned = 2 if passed by ref and adjustments aborted "RTN","RCDPRPL4",87,0) ; returned = -1 if error "RTN","RCDPRPL4",88,0) ; returned = 0 if no WL adjustments found "RTN","RCDPRPL4",89,0) N RCZ,RCZ0,Z00,V00,RCCOM,RC1,RCADJ,RCOK,WLA "RTN","RCDPRPL4",90,0) S RC1=1,RCZ=0,RCADJ=0 "RTN","RCDPRPL4",91,0) F S RCZ=$O(^RCY(344.49,RCSCR,1,RCZ)) Q:'RCZ!(RCADJ=2) S V00=$G(^(RCZ,0)),RCZ0=0 F S RCZ0=$O(^RCY(344.49,RCSCR,1,RCZ,1,RCZ0)) Q:'RCZ0!(RCADJ=2) S Z00=$G(^(RCZ0,0)) Q:"12"'[+$P(Z00,U,5) D "RTN","RCDPRPL4",92,0) . S RCCOM(1)=$P(Z00,U,9) "RTN","RCDPRPL4",93,0) . I RC1,$P(Z00,U,5)=1 D Q:RCADJ=2 "RTN","RCDPRPL4",94,0) .. S RC1=0 "RTN","RCDPRPL4",95,0) .. S DIR(0)="YA",DIR("B")="YES",DIR("A",1)="Generating automatic decrease adjustments from EDI Lbox Worklist ...",DIR("A")="ARE YOU SURE YOU WANT TO CONTINUE?: " "RTN","RCDPRPL4",96,0) .. D ^DIR K DIR "RTN","RCDPRPL4",97,0) .. I Y'=1 S RCADJ=2 "RTN","RCDPRPL4",98,0) . I $P(Z00,U,8)=1 D Q ; previously done "RTN","RCDPRPL4",99,0) .. I $P(Z00,U,5)=1 W !," Automatic decrease adj from ERA Worklist for bill #"_$P($G(^PRCA(430,+$P(V00,U,7),0)),U),!," for amount of "_$J(+$P(Z00,U,3),"",2)_" was previously completed" S RCADJ=1 "RTN","RCDPRPL4",100,0) . I $P(Z00,U,5)=1 D Q ; Decrease adj "RTN","RCDPRPL4",101,0) .. S WLA=$$INCDEC^RCBEUTR1($P(V00,U,7),$P(Z00,U,3),.RCCOM,,,1) I 'WLA D "RTN","RCDPRPL4",102,0) ... ; PRCA276 - $$INCDEC can now return "0^1" which means a negative claim balance could have occurred if the decrease adjustment was applied to the claim "RTN","RCDPRPL4",103,0) ... S RCADJ=-1 W !," Could not perform automatic decrease adj from ERA Worklist for ",!," bill # "_$P($G(^PRCA(430,+$P(V00,U,7),0)),U)_" for amount of "_$J(+$P(Z00,U,3),"",2) "RTN","RCDPRPL4",104,0) ... I $P(WLA,U,2) D "RTN","RCDPRPL4",105,0) .... S RCADJ=2 "RTN","RCDPRPL4",106,0) .... W !,"WARNING: Receipt cannot be processed.",!,"Processing this receipt will cause this bill to have a negative balance",!,"which is outside the scope of VA Accounting regulations." "RTN","RCDPRPL4",107,0) .... W !,"Correct the error and reprocess this receipt." "RTN","RCDPRPL4",108,0) .. E D ; success "RTN","RCDPRPL4",109,0) ... D UPD(RCSCR,RCZ,RCZ0) "RTN","RCDPRPL4",110,0) ... S RCADJ=1 "RTN","RCDPRPL4",111,0) ... W !," EDI Lbox Worklist automatic dec adjustment made to "_$P($G(^PRCA(430,+$P(V00,U,7),0)),U)_": "_$J(+$P(Z00,U,3),"",2) "RTN","RCDPRPL4",112,0) . I $P(Z00,U,5)=2 D Q ; Bill comment "RTN","RCDPRPL4",113,0) .. D ADDCOMM^RCBEUTRA($P(V00,U,7),.RCCOM),UPD(RCSCR,RCZ,RCZ0) "RTN","RCDPRPL4",114,0) ; "RTN","RCDPRPL4",115,0) Q $G(RCADJ) "RTN","RCDPRPL4",116,0) ; "RTN","RCDPRPL4",117,0) UPD(RCSCR,Z,Z0) ; Mark as complete so it doesn't get done twice "RTN","RCDPRPL4",118,0) N DA,DIE,DR "RTN","RCDPRPL4",119,0) S DA(2)=RCSCR,DA(1)=Z,DA=Z0 "RTN","RCDPRPL4",120,0) S DIE="^RCY(344.49,"_DA(2)_",1,"_DA(1)_",1,",DR=".08////1" D ^DIE "RTN","RCDPRPL4",121,0) Q "RTN","RCDPRPL4",122,0) ; "RTN","RCDPRPLM") 0^33^B101101074 "RTN","RCDPRPLM",1,0) RCDPRPLM ; WISC/RFJ-receipt profile List Manager main routine ;31 Oct 2018 09:14:14 "RTN","RCDPRPLM",2,0) ;;4.5;Accounts Receivable;**114,148,149,173,196,220,217,321,326,332**;Mar 20, 1995;Build 40 "RTN","RCDPRPLM",3,0) ;Per VA Directive 6402, this routine should not be modified. "RTN","RCDPRPLM",4,0) ; "RTN","RCDPRPLM",5,0) ; option: Receipt Processing [RCDP RECEIPT PROCESSING] "RTN","RCDPRPLM",6,0) N RCDPFXIT "RTN","RCDPRPLM",7,0) ; "RTN","RCDPRPLM",8,0) RECTPROF ;EP from RECEIPT^RCDPLPL1 "RTN","RCDPRPLM",9,0) ; Entry point called by link payment to prevent NEWing fast exit var RCDPFXIT "RTN","RCDPRPLM",10,0) N RCRECTDA "RTN","RCDPRPLM",11,0) ; "RTN","RCDPRPLM",12,0) F D Q:'RCRECTDA "RTN","RCDPRPLM",13,0) . W !! S RCRECTDA=$$SELRECT^RCDPUREC(1) ; Allow adding new receipt "RTN","RCDPRPLM",14,0) . I RCRECTDA<1 S RCRECTDA=0 Q "RTN","RCDPRPLM",15,0) . D EN^VALM("RCDP RECEIPT PROFILE") "RTN","RCDPRPLM",16,0) . I $G(RCDPFXIT) S RCRECTDA=0 ; Fast exit "RTN","RCDPRPLM",17,0) Q "RTN","RCDPRPLM",18,0) ; "RTN","RCDPRPLM",19,0) INIT ;EP from ListMan template RCDP RECEIPT PROFILE MENU "RTN","RCDPRPLM",20,0) ; EP from CUSTOMIZ^RCDPRPL2 "RTN","RCDPRPLM",21,0) ; Initialization for list manager "RTN","RCDPRPLM",22,0) ; Input: RCRECTDA - IEN for the selected receipt (#344) "RTN","RCDPRPLM",23,0) N DATE,EFTFUND,FMSDOC,GECSDA1,GECSDATA,RCCANCEL,RCEFT,RCDPDATA,RCDPFCAN,RCLINE,RCTOTAL,RCTRDA "RTN","RCDPRPLM",24,0) N RCZ,RCZ0,RCZ1,RCZ2,X,XX,Z,Z0 "RTN","RCDPRPLM",25,0) K ^TMP("RCDPRPLM",$J),^TMP("VALM VIDEO",$J) "RTN","RCDPRPLM",26,0) I $G(RCDPFXIT) S VALMQUIT=1 Q ; Fast exit "RTN","RCDPRPLM",27,0) D DIQ344(RCRECTDA,".02:200") "RTN","RCDPRPLM",28,0) S RCLINE=0 ; list manager line # "RTN","RCDPRPLM",29,0) K ^TMP($J,"RCEFT") "RTN","RCDPRPLM",30,0) S EFTFUND=$S(DT<$$ADDPTEDT^PRCAACC():"5287.4/8NZZ ",1:"528704/8NZZ ") "RTN","RCDPRPLM",31,0) S RCEFT=+$O(^RCY(344.3,"ARDEP",+$P($G(^RCY(344,RCRECTDA,0)),U,6),0)) "RTN","RCDPRPLM",32,0) I RCEFT D "RTN","RCDPRPLM",33,0) . S Z=0 F S Z=$O(^RCY(344.31,"B",RCEFT,Z)) Q:'Z D "RTN","RCDPRPLM",34,0) .. S Z0=$G(^RCY(344.31,+Z,0)) "RTN","RCDPRPLM",35,0) .. I $P(Z0,U,14) S ^TMP($J,"RCEFT",$P(Z0,U,14))=Z_U_$E($P(Z0,U,2),1,12) "RTN","RCDPRPLM",36,0) ; "RTN","RCDPRPLM",37,0) S RCTRDA=0 "RTN","RCDPRPLM",38,0) F S RCTRDA=$O(^RCY(344,RCRECTDA,1,RCTRDA)) Q:'RCTRDA D "RTN","RCDPRPLM",39,0) . D DIQ34401(RCRECTDA,RCTRDA) "RTN","RCDPRPLM",40,0) . S RCLINE=RCLINE+1 D SET("",RCLINE,1,80,.01) "RTN","RCDPRPLM",41,0) . ; Check for payment cancelled "RTN","RCDPRPLM",42,0) . S RCCANCEL=0 "RTN","RCDPRPLM",43,0) . I $P($G(^RCY(344,RCRECTDA,1,RCTRDA,0)),"^",4)=0,$P($G(^(1)),"^")'="" D "RTN","RCDPRPLM",44,0) .. S RCCANCEL=1,RCDPFCAN=1 D SET("**",RCLINE,5,6) "RTN","RCDPRPLM",45,0) . ; Account "RTN","RCDPRPLM",46,0) . I $G(RCDPDATA(344.01,RCTRDA,.03,"E"))="" D "RTN","RCDPRPLM",47,0) .. S:RCEFT XX=EFTFUND_$P($G(^TMP($J,"RCEFT",RCTRDA)),U,2) "RTN","RCDPRPLM",48,0) .. S:'RCEFT XX=$$GETUNAPP^RCXFMSCR(RCRECTDA,RCTRDA,0) "RTN","RCDPRPLM",49,0) .. S RCDPDATA(344.01,RCTRDA,.03,"E")="[ "_XX_" ]" "RTN","RCDPRPLM",50,0) . D SET("",RCLINE,7,33,.03) "RTN","RCDPRPLM",51,0) . ; (#.06) DATE OF PAYMENT [6D] "RTN","RCDPRPLM",52,0) . S X=RCDPDATA(344.01,RCTRDA,.06,"I") D:X "RTN","RCDPRPLM",53,0) .. S XX=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3) D SET(XX,RCLINE,35,42) "RTN","RCDPRPLM",54,0) . ;( #.12) ENTERED BY [12P:200] "RTN","RCDPRPLM",55,0) . S X=RCDPDATA(344.01,RCTRDA,.12,"E") D:$L(X) "RTN","RCDPRPLM",56,0) .. ; if POSTMASTER set to 'ar' else user's initials "RTN","RCDPRPLM",57,0) .. S X=$S(RCDPDATA(344.01,RCTRDA,.12,"I")=.5:"ar",1:$E($P(X,",",2))_$E(X)) "RTN","RCDPRPLM",58,0) .. D SET(X,RCLINE,45,46) "RTN","RCDPRPLM",59,0) . ;(#.14) EDITED BY [14P:200] "RTN","RCDPRPLM",60,0) . S X=RCDPDATA(344.01,RCTRDA,.14,"E") D:$L(X) "RTN","RCDPRPLM",61,0) .. S X=$E($P(X,",",2))_$E(X) D SET(X,RCLINE,54,55) "RTN","RCDPRPLM",62,0) . D SET($J(RCDPDATA(344.01,RCTRDA,.04,"E"),8,2),RCLINE,62,70) ; (#.04) PAYMENT AMOUNT [4N] "RTN","RCDPRPLM",63,0) . D SET($J(RCDPDATA(344.01,RCTRDA,.05,"E"),8,2),RCLINE,72,80) ; (#.05) AMOUNT PROCESSED [5N] "RTN","RCDPRPLM",64,0) . ; "RTN","RCDPRPLM",65,0) . ; If not processed, show if amount > bill "RTN","RCDPRPLM",66,0) . S X=$$CHECKPAY^RCDPRPL3(RCRECTDA,RCTRDA) D:X "RTN","RCDPRPLM",67,0) .. S XX=" WARNING: Pending Payments ($ "_$J($P(X,"^",3),0,2)_") exceed amount billed ($ "_$J($P(X,"^",2),0,2)_")" "RTN","RCDPRPLM",68,0) .. S RCLINE=RCLINE+1 D SET(XX,RCLINE,1,80) "RTN","RCDPRPLM",69,0) . ; Show line 2 for check/credit payment "RTN","RCDPRPLM",70,0) . I $$OPTCK^RCDPRPL2("SHOWCHECK",2) D "RTN","RCDPRPLM",71,0) .. ; Receipt type is check "RTN","RCDPRPLM",72,0) .. I RCDPDATA(344,RCRECTDA,.04,"I")=4!(RCDPDATA(344,RCRECTDA,.04,"I")=12) D Q "RTN","RCDPRPLM",73,0) ... S RCLINE=RCLINE+1 D SET(" Check #",RCLINE,1,80,.07) "RTN","RCDPRPLM",74,0) ... S X=RCDPDATA(344.01,RCTRDA,.1,"I") S:'X X="???????" "RTN","RCDPRPLM",75,0) ... S XX="Date: "_$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3) D SET(XX,RCLINE,32,80) "RTN","RCDPRPLM",76,0) ... D SET("Bank #",RCLINE,47,80,.08) "RTN","RCDPRPLM",77,0) .. ; Receipt type of payment is credit "RTN","RCDPRPLM",78,0) .. I RCDPDATA(344,RCRECTDA,.04,"I")=7 D Q "RTN","RCDPRPLM",79,0) ... S RCLINE=RCLINE+1 D SET(" Card #",RCLINE,1,80,.11),SET("Confirmation #",RCLINE,35,80,.02) "RTN","RCDPRPLM",80,0) .. ; type of payment is EDI LOCKBOX "RTN","RCDPRPLM",81,0) .. I RCDPDATA(344,RCRECTDA,.04,"I")=14 D Q "RTN","RCDPRPLM",82,0) ... S RCLINE=RCLINE+1 D SET(" Trace #",RCLINE,1,80,.17) "RTN","RCDPRPLM",83,0) . ; line 3 for acct. lookup, batch #, sequence # "RTN","RCDPRPLM",84,0) . I $$OPTCK^RCDPRPL2("SHOWACCT",2) D "RTN","RCDPRPLM",85,0) .. N TRNS ; transaction info "RTN","RCDPRPLM",86,0) .. S TRNS("acctLkup")=RCDPDATA(344.01,RCTRDA,.21,"E") ; (#.21) ACCOUNT LOOKUP [1F] "RTN","RCDPRPLM",87,0) .. S TRNS("btch#")=RCDPDATA(344.01,RCTRDA,.22,"E") ; (#.22) BATCH NUMBER [2N] "RTN","RCDPRPLM",88,0) .. S TRNS("sq#")=RCDPDATA(344.01,RCTRDA,.23,"E") ; (#.23) SEQUENCE NUMBER [3N] "RTN","RCDPRPLM",89,0) .. I TRNS("acctLkup")="",TRNS("btch#")="",TRNS("sq#")="" Q ; No Account information, skip "RTN","RCDPRPLM",90,0) .. S RCLINE=RCLINE+1 "RTN","RCDPRPLM",91,0) .. D SET(" AcctLU",RCLINE,1,80,.21),SET("Batch/Sequence: "_TRNS("btch#")_"/"_TRNS("sq#"),RCLINE,37,80) "RTN","RCDPRPLM",92,0) . ; Show if posting error "RTN","RCDPRPLM",93,0) . I $$OPTCK^RCDPRPL2("SHOWCOMMENTS",2),RCDPDATA(344.01,RCTRDA,1.01,"E")'="" D "RTN","RCDPRPLM",94,0) .. S X=$S(RCCANCEL:"Cancel Data",1:"Posting Error") "RTN","RCDPRPLM",95,0) .. S RCLINE=RCLINE+1 D SET(" "_X,RCLINE,1,80,1.01) "RTN","RCDPRPLM",96,0) . ; Show if comment "RTN","RCDPRPLM",97,0) . I $$OPTCK^RCDPRPL2("SHOWCOMMENTS",2),RCDPDATA(344.01,RCTRDA,1.02,"E")'="" D "RTN","RCDPRPLM",98,0) .. S RCLINE=RCLINE+1 D SET(" Comment",RCLINE,1,80,1.02) "RTN","RCDPRPLM",99,0) . ; If EDI Lockbox pending adjustments, show it "RTN","RCDPRPLM",100,0) . I $P($G(^RCY(344,RCRECTDA,0)),U,18),$G(RCDPDATA(344.01,RCTRDA,.27,"E")) D "RTN","RCDPRPLM",101,0) .. S RCZ=$P(^RCY(344,RCRECTDA,0),U,18),RCZ0=RCDPDATA(344.01,RCTRDA,.27,"E") "RTN","RCDPRPLM",102,0) .. S RCZ1=0 F S RCZ1=$O(^RCY(344.49,RCZ,1,RCZ0,1,RCZ1)) Q:'RCZ1 S RCZ2=$G(^(RCZ1,0)) D "RTN","RCDPRPLM",103,0) ... I $P(RCZ2,U,5)'="","12"[$P(RCZ2,U,5),'$P(RCZ2,U,8) D "RTN","RCDPRPLM",104,0) .... I $P(RCZ2,U,5)=1 D Q "RTN","RCDPRPLM",105,0) ..... S RCLINE=RCLINE+1 D SET(" Pending decrease adjustment for "_$J($P(RCZ2,U,3),"",2),RCLINE,1,80) "RTN","RCDPRPLM",106,0) .... I $$OPTCK^RCDPRPL2("SHOWCOMMENTS",2),$P(RCZ2,U,5)=2 D Q "RTN","RCDPRPLM",107,0) ..... S RCLINE=RCLINE+1 D SET(" Comment: "_$P(RCZ2,U,9),RCLINE,1,80) "RTN","RCDPRPLM",108,0) . ; Calculate totals "RTN","RCDPRPLM",109,0) . S RCTOTAL(1)=$G(RCTOTAL(1))+RCDPDATA(344.01,RCTRDA,.04,"E") "RTN","RCDPRPLM",110,0) . S RCTOTAL(2)=$G(RCTOTAL(2))+RCDPDATA(344.01,RCTRDA,.05,"E") "RTN","RCDPRPLM",111,0) . ; cleanup "RTN","RCDPRPLM",112,0) . K RCDPDATA(344.01,RCTRDA) "RTN","RCDPRPLM",113,0) ; "RTN","RCDPRPLM",114,0) ; Show totals "RTN","RCDPRPLM",115,0) K ^TMP($J,"RCEFT") "RTN","RCDPRPLM",116,0) S RCLINE=RCLINE+1 D SET("",RCLINE,1,80),SET("-------- --------",RCLINE,62,80) "RTN","RCDPRPLM",117,0) S RCLINE=RCLINE+1 D SET(" TOTAL DOLLARS FOR RECEIPT",RCLINE,1,80) "RTN","RCDPRPLM",118,0) D SET($J($G(RCTOTAL(1)),8,2),RCLINE,62,70) "RTN","RCDPRPLM",119,0) D SET($J($G(RCTOTAL(2)),8,2),RCLINE,72,80) "RTN","RCDPRPLM",120,0) ; "RTN","RCDPRPLM",121,0) ; Show cancelled "RTN","RCDPRPLM",122,0) I $G(RCDPFCAN) S RCLINE=RCLINE+1 D SET("**indicates payment is CANCELLED",RCLINE,5,80) "RTN","RCDPRPLM",123,0) ; "RTN","RCDPRPLM",124,0) ; Show history "RTN","RCDPRPLM",125,0) S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80) "RTN","RCDPRPLM",126,0) ; "RTN","RCDPRPLM",127,0) ; Start history on first line of a screen if it does not fit on current screen "RTN","RCDPRPLM",128,0) I (RCLINE#12)>8 F X=(RCLINE#12):1:12 S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80) "RTN","RCDPRPLM",129,0) S RCLINE=RCLINE+1 D SET("Receipt History",RCLINE,1,80,0,IOUON,IOUOFF) "RTN","RCDPRPLM",130,0) S DATE=RCDPDATA(344,RCRECTDA,.03,"E"),DATE=$P(DATE,"@")_" "_$P($P(DATE,"@",2),":",1,2) "RTN","RCDPRPLM",131,0) I RCDPDATA(344,RCRECTDA,.02,"I")=.5 S RCDPDATA(344,RCRECTDA,.02,"E")="accounts receivable" "RTN","RCDPRPLM",132,0) S XX=$E(" Opened By: "_RCDPDATA(344,RCRECTDA,.02,"E")_$$SP,1,39)_"Date/Time Opened: "_DATE "RTN","RCDPRPLM",133,0) S RCLINE=RCLINE+1 D SET(XX,RCLINE,1,80) "RTN","RCDPRPLM",134,0) ; (#.12) DATE/TIME LAST EDIT [12D] "RTN","RCDPRPLM",135,0) S DATE=RCDPDATA(344,RCRECTDA,.12,"E"),DATE=$P(DATE,"@")_" "_$P($P(DATE,"@",2),":",1,2) "RTN","RCDPRPLM",136,0) S X=RCDPDATA(344,RCRECTDA,.11,"E") I RCDPDATA(344,RCRECTDA,.11,"I")=.5 S X="accounts receivable" "RTN","RCDPRPLM",137,0) S XX=$E("Last Edit By: "_X_$$SP,1,39)_"Date/Time Last Edit: "_DATE "RTN","RCDPRPLM",138,0) S RCLINE=RCLINE+1 D SET(XX,RCLINE,1,80) "RTN","RCDPRPLM",139,0) ; (#.08) DATE/TIME PROCESSED [8D] "RTN","RCDPRPLM",140,0) S DATE=RCDPDATA(344,RCRECTDA,.08,"E"),DATE=$P(DATE,"@")_" "_$P($P(DATE,"@",2),":",1,2) "RTN","RCDPRPLM",141,0) I RCDPDATA(344,RCRECTDA,.07,"I")=.5 S RCDPDATA(344,RCRECTDA,.07,"E")="accounts receivable" "RTN","RCDPRPLM",142,0) S XX=$E("Processed By: "_RCDPDATA(344,RCRECTDA,.07,"E")_$$SP,1,39)_"Date/Time Processed: "_DATE "RTN","RCDPRPLM",143,0) S RCLINE=RCLINE+1 D SET(XX,RCLINE,1,80) "RTN","RCDPRPLM",144,0) ; "RTN","RCDPRPLM",145,0) ; Show FMS code sheets if switch on in file 342.3 "RTN","RCDPRPLM",146,0) I $$OPTCK^RCDPRPL2("SHOWFMS",2) D "RTN","RCDPRPLM",147,0) . S FMSDOC=$$FMSSTAT^RCDPUREC(RCRECTDA) "RTN","RCDPRPLM",148,0) . S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80) "RTN","RCDPRPLM",149,0) . S RCLINE=RCLINE+1 D SET("FMS Cash Receipt Document:",RCLINE,1,80,0,IOUON,IOUOFF) "RTN","RCDPRPLM",150,0) . D SET($P(FMSDOC,"^")_$S($P(FMSDOC,"^",3):"(on deposit)",1:""),RCLINE,28,80) "RTN","RCDPRPLM",151,0) . D SET("Status: "_$P(FMSDOC,"^",2),RCLINE,55,80) "RTN","RCDPRPLM",152,0) . D DATA^GECSSGET($P(FMSDOC,"^"),1) "RTN","RCDPRPLM",153,0) . I '$G(GECSDATA) Q "RTN","RCDPRPLM",154,0) . S GECSDA1=0 F S GECSDA1=$O(GECSDATA(2100.1,GECSDATA,10,GECSDA1)) Q:'GECSDA1 D "RTN","RCDPRPLM",155,0) .. S RCLINE=RCLINE+1 D SET(GECSDATA(2100.1,GECSDATA,10,GECSDA1),RCLINE,1,80) "RTN","RCDPRPLM",156,0) ; "RTN","RCDPRPLM",157,0) ; Show EEOB detail if switch on "RTN","RCDPRPLM",158,0) D SHEOB^RCDPRPL2 "RTN","RCDPRPLM",159,0) ; "RTN","RCDPRPLM",160,0) ; # of lines in list "RTN","RCDPRPLM",161,0) S VALMCNT=RCLINE "RTN","RCDPRPLM",162,0) D HDR "RTN","RCDPRPLM",163,0) Q "RTN","RCDPRPLM",164,0) ; "RTN","RCDPRPLM",165,0) SET(STRING,LINE,COLBEG,COLEND,FIELD,ON,OFF) ; Sets a line into the body "RTN","RCDPRPLM",166,0) ; of the ListMan template "RTN","RCDPRPLM",167,0) ; Input: "RTN","RCDPRPLM",168,0) ; STRING - Label for the data being set "RTN","RCDPRPLM",169,0) ; LINE - line # being built "RTN","RCDPRPLM",170,0) ; COLBEG - Beginning column for the text "RTN","RCDPRPLM",171,0) ; COLEND - Ending column for the text "RTN","RCDPRPLM",172,0) ; FIELD - Field # for value being set, optional "RTN","RCDPRPLM",173,0) ; NOTE: if FIELD is .17 trace # is retrieved from EFT record "RTN","RCDPRPLM",174,0) ; ON, OFF - for text characteristics "RTN","RCDPRPLM",175,0) ; RCDPDATA - array for receipt being processed "RTN","RCDPRPLM",176,0) ; RCTRDA - IEN in TRANSACTION sub-file (#344.01) "RTN","RCDPRPLM",177,0) N XX "RTN","RCDPRPLM",178,0) I $G(FIELD) D "RTN","RCDPRPLM",179,0) . I FIELD=.17 S XX=$$TRCNUM(RCRECTDA) Q ; trace # from EFT record, PRCA*4.5*332 "RTN","RCDPRPLM",180,0) . ; all other fields "RTN","RCDPRPLM",181,0) . S XX=$G(RCDPDATA(344.01,RCTRDA,FIELD,"E")) "RTN","RCDPRPLM",182,0) S:$G(FIELD) STRING=STRING_$S(STRING="":"",1:": ")_XX "RTN","RCDPRPLM",183,0) I STRING="",'$G(FIELD) D SET^VALM10(LINE,$J("",80)) Q "RTN","RCDPRPLM",184,0) I '$D(@VALMAR@(LINE,0)) D SET^VALM10(LINE,$J("",80)) "RTN","RCDPRPLM",185,0) D SET^VALM10(LINE,$$SETSTR^VALM1(STRING,@VALMAR@(LINE,0),COLBEG,COLEND-COLBEG+1)) "RTN","RCDPRPLM",186,0) I $G(ON)'=""!($G(OFF)'="") D CNTRL^VALM10(LINE,COLBEG,$L(STRING),ON,OFF) "RTN","RCDPRPLM",187,0) Q "RTN","RCDPRPLM",188,0) ; "RTN","RCDPRPLM",189,0) TRCNUM(ARBPIEN) ; returns trace #, ARBPIEN is IEN in file #344 - PRCA*4.5*332 "RTN","RCDPRPLM",190,0) N DEPIEN,PTR "RTN","RCDPRPLM",191,0) ; If receipt manually created then EFT number is in field .17 "RTN","RCDPRPLM",192,0) S PTR=+$P($G(^RCY(344,ARBPIEN,0)),U,17) ;(#.17) EFT RECORD [17P:344.31] "RTN","RCDPRPLM",193,0) ; Otherwise auto-posting created the receipt, get the EFT number "RTN","RCDPRPLM",194,0) D:'PTR "RTN","RCDPRPLM",195,0) . S DEPIEN=+$P($G(^RCY(344,ARBPIEN,0)),U,6) ; (#.06) DEPOSIT TICKET [6P:344.1] "RTN","RCDPRPLM",196,0) . S PTR=+$O(^RCY(344.3,"ARDEP",DEPIEN,0)) ; use deposit IEN to get IEN in fil #344.3 "RTN","RCDPRPLM",197,0) . S PTR=+$O(^RCY(344.31,"B",PTR,0)) ; Get the EFT Number "RTN","RCDPRPLM",198,0) ; "RTN","RCDPRPLM",199,0) Q $$GET1^DIQ(344.31,PTR_",",.04,"E") ;(#.04) TRACE # [4F] "RTN","RCDPRPLM",200,0) ; "RTN","RCDPRPLM",201,0) DIQ344(DA,DR) ; Retrieves data for fields in file #344 "RTN","RCDPRPLM",202,0) ; Input: DA - IEN of the receipt to retrieve data from (#344) "RTN","RCDPRPLM",203,0) ; DR - List of fields to retrieve data for "RTN","RCDPRPLM",204,0) ; Output: RCDPDATA - Array of retrieved data "RTN","RCDPRPLM",205,0) N %I,D0,DIC,DIQ,YY "RTN","RCDPRPLM",206,0) K RCDPDATA(344,DA) "RTN","RCDPRPLM",207,0) S DIQ(0)="IE",DIC="^RCY(344,",DIQ="RCDPDATA" "RTN","RCDPRPLM",208,0) D EN^DIQ1 "RTN","RCDPRPLM",209,0) Q "RTN","RCDPRPLM",210,0) ; "RTN","RCDPRPLM",211,0) DIQ34401(DA,SUBDA) ; Retrieves data for fields in the transaction subfile (#344.01) "RTN","RCDPRPLM",212,0) ; of the receipt file (#344) "RTN","RCDPRPLM",213,0) ; Input: DA - IEN of the receipt to retrieve data from (#344) "RTN","RCDPRPLM",214,0) ; SUBDA - IEN of the sub-file record (#344.01) "RTN","RCDPRPLM",215,0) ; Output: RCDPDATA - Array of retrieved data "RTN","RCDPRPLM",216,0) N %I,D0,DIC,DIQ,DR "RTN","RCDPRPLM",217,0) K RCDPDATA(344.01,SUBDA) "RTN","RCDPRPLM",218,0) S DR=1,DR(344.01)=".01:1.02",DA(344.01)=SUBDA "RTN","RCDPRPLM",219,0) S DIQ(0)="IE",DIC="^RCY(344,",DIQ="RCDPDATA" "RTN","RCDPRPLM",220,0) D EN^DIQ1 "RTN","RCDPRPLM",221,0) Q "RTN","RCDPRPLM",222,0) ; "RTN","RCDPRPLM",223,0) HDR ;EP from ListMan Template RCDP RECEIPT PROFILE "RTN","RCDPRPLM",224,0) ; Header code for list manager display "RTN","RCDPRPLM",225,0) N DATE,DEPIEN,EFTIEN,ERAIEN,FMSDOC,FMSTTR,PAYER,RCDPDATA,RCEFT,XX,Z "RTN","RCDPRPLM",226,0) D DIQ344(RCRECTDA,".01;.04;.06;.08;.14;.17;.18;") "RTN","RCDPRPLM",227,0) ; "RTN","RCDPRPLM",228,0) ; PRCA*4.5*321 - Start of modified code block "RTN","RCDPRPLM",229,0) S XX=$E(" Receipt #: "_RCDPDATA(344,RCRECTDA,.01,"E")_$$SP,1,39) "RTN","RCDPRPLM",230,0) S XX=XX_"Type of Payment: "_RCDPDATA(344,RCRECTDA,.04,"E") "RTN","RCDPRPLM",231,0) S VALMHDR(1)=XX "RTN","RCDPRPLM",232,0) ; "RTN","RCDPRPLM",233,0) S Z=RCDPDATA(344,RCRECTDA,.06,"E") "RTN","RCDPRPLM",234,0) S DEPIEN=+$P($G(^RCY(344,RCRECTDA,0)),U,6) "RTN","RCDPRPLM",235,0) S RCEFT=+$O(^RCY(344.3,"ARDEP",DEPIEN,0)) "RTN","RCDPRPLM",236,0) S EFTIEN=RCDPDATA(344,RCRECTDA,.17,"I") "RTN","RCDPRPLM",237,0) S FMSDOC=$$FMSSTAT^RCDPUREC(RCRECTDA) "RTN","RCDPRPLM",238,0) S FMSTTR=$S($P(FMSDOC,"-",1)="TR":1,1:0) "RTN","RCDPRPLM",239,0) S XX="" D "RTN","RCDPRPLM",240,0) . I 'RCEFT&'EFTIEN S XX=" Deposit #: "_Z Q "RTN","RCDPRPLM",241,0) . I RCEFT S XX=" EFT Deposit: "_Z Q "RTN","RCDPRPLM",242,0) . ; PRCA*4.5*321 - Since EFT and ERA are now displayed on their own line, put TIN/Payer here "RTN","RCDPRPLM",243,0) . N TIN "RTN","RCDPRPLM",244,0) . S PAYER=$$GET1^DIQ(344.31,EFTIEN_",",.02,"E") "RTN","RCDPRPLM",245,0) . S TIN=$$GET1^DIQ(344.31,EFTIEN_",",.03,"E") "RTN","RCDPRPLM",246,0) . S XX=" Payer: "_TIN_"/"_PAYER "RTN","RCDPRPLM",247,0) S XX=$E(XX_$$SP,1,39)_" Receipt Status: "_RCDPDATA(344,RCRECTDA,.14,"E") "RTN","RCDPRPLM",248,0) S VALMHDR(2)=XX "RTN","RCDPRPLM",249,0) ; "RTN","RCDPRPLM",250,0) S ERAIEN=RCDPDATA(344,RCRECTDA,.18,"I") "RTN","RCDPRPLM",251,0) S XX="" "RTN","RCDPRPLM",252,0) I FMSTTR!ERAIEN S XX=" ERA #: "_RCDPDATA(344,RCRECTDA,.18,"E") "RTN","RCDPRPLM",253,0) S XX=$E(XX_$$SP,1,21) "RTN","RCDPRPLM",254,0) I FMSTTR!ERAIEN S XX=XX_"ERA TTL: "_$J($$GET1^DIQ(344.4,ERAIEN_",",.05,"E"),9) "RTN","RCDPRPLM",255,0) S XX=$E(XX_$$SP,1,39) "RTN","RCDPRPLM",256,0) ; "RTN","RCDPRPLM",257,0) ; FMS document and status "RTN","RCDPRPLM",258,0) S XX=XX_" FMS Document: "_$TR($P(FMSDOC,"^")," ")_$S($P(FMSDOC,"^",3):"(on deposit)",1:"") "RTN","RCDPRPLM",259,0) S VALMHDR(3)=XX "RTN","RCDPRPLM",260,0) ; "RTN","RCDPRPLM",261,0) S XX="" "RTN","RCDPRPLM",262,0) I FMSTTR!EFTIEN D "RTN","RCDPRPLM",263,0) . S XX=" EFT #: "_$$GET1^DIQ(344.31,EFTIEN_",",.01,"I")_"." "RTN","RCDPRPLM",264,0) . S XX=XX_$$GET1^DIQ(344.31,EFTIEN_",",.14) ; PRCA*4.5*326 "RTN","RCDPRPLM",265,0) S XX=$E(XX_$$SP,1,21) "RTN","RCDPRPLM",266,0) I FMSTTR!EFTIEN S XX=XX_"EFT TTL: "_$J($$GET1^DIQ(344.31,EFTIEN_",",.07,"E"),9)_" " "RTN","RCDPRPLM",267,0) S XX=$E(XX_$$SP,1,39) "RTN","RCDPRPLM",268,0) S XX=XX_" FMS Doc Status: "_$P(FMSDOC,"^",2) "RTN","RCDPRPLM",269,0) S VALMHDR(4)=XX "RTN","RCDPRPLM",270,0) ; PRCA*4.5*321 - End of modified code block "RTN","RCDPRPLM",271,0) ; "RTN","RCDPRPLM",272,0) I RCDPDATA(344,RCRECTDA,.08,"I") D "RTN","RCDPRPLM",273,0) . S VALMSG="Receipt processed on "_RCDPDATA(344,RCRECTDA,.08,"E") "RTN","RCDPRPLM",274,0) Q "RTN","RCDPRPLM",275,0) ; "RTN","RCDPRPLM",276,0) EXIT ;EP from ListMan Template RCDP RECEIPT PROFILE "RTN","RCDPRPLM",277,0) ; Exit option/clean up "RTN","RCDPRPLM",278,0) K ^TMP("RCDPRPLM",$J) "RTN","RCDPRPLM",279,0) Q "RTN","RCDPRPLM",280,0) ; "RTN","RCDPRPLM",281,0) SP() Q $J("",132) ; extrinsic variable, 132 spaces "RTN","RCDPRPLM",282,0) ; "RTN","RCDPRSEA") 0^15^B85725448 "RTN","RCDPRSEA",1,0) RCDPRSEA ;WISC/RFJ,PJH,hrub - extended search ;31 Oct 2018 18:43:20 "RTN","RCDPRSEA",2,0) ;;4.5;Accounts Receivable;**114,148,208,269,304,332**;Mar 20, 1995;Build 40 "RTN","RCDPRSEA",3,0) ;Per VA Directive 6402, this routine should not be modified. "RTN","RCDPRSEA",4,0) ; "RTN","RCDPRSEA",5,0) ; enter at top for [RCDP EXTENDED CHECK/CC SEARCH] option "RTN","RCDPRSEA",6,0) N DATEEND,DATESTRT,RCDUP,RCPAYTYP,RCRPRT,RCRTRN,RCSRCH,RCTRGT,X,Y "RTN","RCDPRSEA",7,0) ; "RTN","RCDPRSEA",8,0) ; search check, credit card, trace #, or All "RTN","RCDPRSEA",9,0) W !!,"Extended AR BATCH PAYMENT file search.",! "RTN","RCDPRSEA",10,0) S RCSRCH=$$ASKSEA I RCSRCH<1 Q "RTN","RCDPRSEA",11,0) ; "RTN","RCDPRSEA",12,0) S RCTRGT("Any#")=U F X=1,2,3 S RCTRGT($$SBSCRPT(X))=U ; initialize all search targets "RTN","RCDPRSEA",13,0) ; check # to search for "RTN","RCDPRSEA",14,0) I RCSRCH=1 S RCTRGT("Check#")=$$ASKCHEK^RCDPLPL1 I RCTRGT("Check#")=-1 Q "RTN","RCDPRSEA",15,0) ; credit card to search for "RTN","RCDPRSEA",16,0) I RCSRCH=2 S RCTRGT("CredCard")=$$ASKCRED^RCDPLPL1 I RCTRGT("CredCard")=-1 Q "RTN","RCDPRSEA",17,0) ; trace # to search for "RTN","RCDPRSEA",18,0) I RCSRCH=3 S RCTRGT("Trace#")=$$ASKTRACE^RCDPLPL1 I RCTRGT("Trace#")=-1 Q "RTN","RCDPRSEA",19,0) I RCSRCH=4 D I RCTRGT("Any#")=U Q "RTN","RCDPRSEA",20,0) . S RCTRGT("Any#")=$$ASK4ALL Q:RCTRGT("Any#")=U "RTN","RCDPRSEA",21,0) . S (RCTRGT("Check#"),RCTRGT("CredCard"),RCTRGT("Trace#"))=RCTRGT("Any#") ; for all 3 types of search "RTN","RCDPRSEA",22,0) ; ask contains or equals "RTN","RCDPRSEA",23,0) S RCSRCH("type")=$$ASKTYPE^RCDPLPL1 I RCSRCH("type")=-1 Q "RTN","RCDPRSEA",24,0) S RCSRCH("type")=$E(RCSRCH("type")) ; will be "E" or "C" "RTN","RCDPRSEA",25,0) S RCDUP=0 "RTN","RCDPRSEA",26,0) I (RCSRCH=3!(RCSRCH=4))&($L($G(RCTRGT("Trace#")))>44) D I RCDUP=-1 Q "RTN","RCDPRSEA",27,0) . S RCDUP=$$ASKDUP() "RTN","RCDPRSEA",28,0) ; "RTN","RCDPRSEA",29,0) ; ask receipt open dates "RTN","RCDPRSEA",30,0) W ! D DATESEL^RCRJRTRA("RECEIPT Opened") "RTN","RCDPRSEA",31,0) I '$G(DATESTRT)!('$G(DATEEND)) Q "RTN","RCDPRSEA",32,0) ; "RTN","RCDPRSEA",33,0) F X=1,2,3 S RCTRGT($$SBSCRPT(X))=$$UP(RCTRGT($$SBSCRPT(X))) ; case-insensitive search "RTN","RCDPRSEA",34,0) S RCSRCH("FromDt")=DATESTRT\1,RCSRCH("ToDt")=DATEEND\1 ; start/end dates without time "RTN","RCDPRSEA",35,0) S RCRPRT("HdrFrom")=$$FMTE^XLFDT(RCSRCH("FromDt")),RCRPRT("HdrTo")=$$FMTE^XLFDT(RCSRCH("ToDt")) "RTN","RCDPRSEA",36,0) ; select device "RTN","RCDPRSEA",37,0) W ! N %ZIS S %ZIS="Q" D ^%ZIS I POP Q "RTN","RCDPRSEA",38,0) I $D(IO("Q")) D Q "RTN","RCDPRSEA",39,0) . N ZTDESC,ZTQUEUED,ZTRTN,ZTSAVE,ZTSK "RTN","RCDPRSEA",40,0) . S ZTDESC="Extended Check/Trace#/Credit Card Search" "RTN","RCDPRSEA",41,0) . S ZTSAVE("RC*")="",ZTSAVE("ZTREQ")="@",ZTRTN="DQ^"_$T(+0) "RTN","RCDPRSEA",42,0) . D ^%ZTLOAD "RTN","RCDPRSEA",43,0) . W !!,$S($G(ZTSK):"Report queued as task #"_ZTSK,1:"Unable to queue this report.") "RTN","RCDPRSEA",44,0) . K IO("Q") "RTN","RCDPRSEA",45,0) ; from here on for interactive user only "RTN","RCDPRSEA",46,0) F D Q:RCSRCH("Exit") ; loop here if no results found "RTN","RCDPRSEA",47,0) . D DQ I RCSRCH("Cntr")!RCSRCH("Exit") S RCSRCH("Exit")=1 Q ; results returned or exit indicated "RTN","RCDPRSEA",48,0) . I RCSRCH=4 S RCSRCH("Exit")=1 Q ; 'All' was selected, don't ask, exit "RTN","RCDPRSEA",49,0) . S RCSRCH("PrevType")=RCSRCH ; save for user interaction "RTN","RCDPRSEA",50,0) . S RCSRCH("Exit")='$$ASK2CONT Q:RCSRCH("Exit") "RTN","RCDPRSEA",51,0) . F D Q:'$L(RCSRCH("PrevType"))!RCSRCH("Exit") "RTN","RCDPRSEA",52,0) .. S RCSRCH("NewType")=$$ASKSEA I RCSRCH("NewType")<1 S RCSRCH("Exit")=1 Q "RTN","RCDPRSEA",53,0) .. I RCSRCH("NewType")=RCSRCH("PrevType") D Q "RTN","RCDPRSEA",54,0) ... N DIR,DTOUT,DUOUT,X,Y "RTN","RCDPRSEA",55,0) ... S DIR(0)="EA",DIR("A")="Press ENTER to continue, '^' to exit: " "RTN","RCDPRSEA",56,0) ... S DIR("A",1)=" ",DIR("A",2)="That was the previous search type." "RTN","RCDPRSEA",57,0) ... S DIR("A",3)="Please select another type of search." D ^DIR "RTN","RCDPRSEA",58,0) ... S RCSRCH("Exit")=$S(X[U!$D(DUOUT)!$D(DTOUT):1,1:0) "RTN","RCDPRSEA",59,0) .. Q:RCSRCH("Exit") "RTN","RCDPRSEA",60,0) .. F X=1,2,3 S RCTRGT($$SBSCRPT(X))=U ; re-initialize all search targets "RTN","RCDPRSEA",61,0) .. S RCSRCH=RCSRCH("NewType"),RCSRCH("PrevType")="" ; set previous type to null to exit loop "RTN","RCDPRSEA",62,0) .. S RCTRGT($$SBSCRPT(RCSRCH))=RCSRCH("PrevTrgt") "RTN","RCDPRSEA",63,0) .. I RCSRCH=4 F X=1,2,3 S RCTRGT($$SBSCRPT(X))=RCSRCH("PrevTrgt") ; if new search is ALL "RTN","RCDPRSEA",64,0) ; "RTN","RCDPRSEA",65,0) Q "RTN","RCDPRSEA",66,0) ; "RTN","RCDPRSEA",67,0) DQ ; entry from TaskMan or from above "RTN","RCDPRSEA",68,0) N A,B,J,RCACCNT,RCBTCH,RCPAYTYP,RCTRANS,RCTRCNUM,RCXREFDT,X,Y "RTN","RCDPRSEA",69,0) ; print report "RTN","RCDPRSEA",70,0) S RCRPRT("HdrTime")=$$FMTE^XLFDT($$NOW^XLFDT) ; NOW in external format "RTN","RCDPRSEA",71,0) S RCRPRT("HdrPage#")=1,RCSRCH("Exit")=0,RCSRCH("Cntr")=0 ; page number, exit flag, found count "RTN","RCDPRSEA",72,0) ; save target for additional searches "RTN","RCDPRSEA",73,0) S RCSRCH("PrevTrgt")=RCTRGT($$SBSCRPT(RCSRCH)) "RTN","RCDPRSEA",74,0) U IO D H "RTN","RCDPRSEA",75,0) S RCXREFDT=RCSRCH("ToDt")+.5 ; initialize to last date plus a fraction, "AO" index has time "RTN","RCDPRSEA",76,0) F S RCXREFDT=$O(^RCY(344,"AO",RCXREFDT),-1) Q:'RCXREFDT!(RCXREFDT(IOSL-6) D Q:RCSRCH("Exit") "RTN","RCDPRSEA",120,0) . S RCSRCH("Exit")=0 "RTN","RCDPRSEA",121,0) . N DIR,X,Y "RTN","RCDPRSEA",122,0) . S DIR(0)="EA",DIR("A")="Press ENTER to continue, '^' to exit: " D ^DIR "RTN","RCDPRSEA",123,0) . S RCSRCH("Exit")=$S(X[U!$D(DUOUT)!$D(DTOUT):1,1:0) "RTN","RCDPRSEA",124,0) . Q:RCSRCH("Exit") ; user indicated to stop "RTN","RCDPRSEA",125,0) . D H "RTN","RCDPRSEA",126,0) ; next line for non-interactive device "RTN","RCDPRSEA",127,0) I '($E(IOST,1,2)="C-"),$Y>(IOSL-2) D H "RTN","RCDPRSEA",128,0) ; receipt "RTN","RCDPRSEA",129,0) S J=$P(RCBTCH(0),U),A=$P(RCBTCH(0),U,3) ; A is the date opened "RTN","RCDPRSEA",130,0) S J=J_$J(" ",15-$L(J))_$E(A,4,5)_"/"_$E(A,6,7)_"/"_$E(A,2,3) ; format date opened "RTN","RCDPRSEA",131,0) S J=J_$J(" ",27-$L(J))_RCTRANS ; add transaction number "RTN","RCDPRSEA",132,0) ; account "RTN","RCDPRSEA",133,0) S RCACCNT("Pntr")=$P(RCTRANS(0),U,3),RCACCNT=" -" "RTN","RCDPRSEA",134,0) I RCACCNT("Pntr")["PRCA(430," S RCACCNT=$P($G(^PRCA(430,+RCACCNT("Pntr"),0)),U) "RTN","RCDPRSEA",135,0) I RCACCNT("Pntr")["DPT(" S RCACCNT=$P($G(^DPT(+RCACCNT("Pntr"),0)),U) "RTN","RCDPRSEA",136,0) S J=J_$J(" ",31-$L(J))_RCACCNT ; add account "RTN","RCDPRSEA",137,0) S J=J_$J(" ",55-$L(J))_"$"_$J($P(RCTRANS(0),U,4),8,2) ; add amount "RTN","RCDPRSEA",138,0) W !,J "RTN","RCDPRSEA",139,0) ; check/trace/credit card number "RTN","RCDPRSEA",140,0) S J=RCITMFND "RTN","RCDPRSEA",141,0) ; if search all types, indicate what was found "RTN","RCDPRSEA",142,0) I RCSRCH=4 S J=J_" ("_$S(RCPAYTYP=1:"Check #",RCPAYTYP=2:"Credit Card",1:"Trace #")_")" "RTN","RCDPRSEA",143,0) W !," "_J "RTN","RCDPRSEA",144,0) Q "RTN","RCDPRSEA",145,0) ; "RTN","RCDPRSEA",146,0) H ; header "RTN","RCDPRSEA",147,0) S A=RCRPRT("HdrTime")_" Page: "_RCRPRT("HdrPage#"),RCRPRT("HdrPage#")=RCRPRT("HdrPage#")+1 "RTN","RCDPRSEA",148,0) S B="Extended Check #/Trace #/Credit Card Search",$E(B,80-$L(A)+1,80)=A "RTN","RCDPRSEA",149,0) W @IOF,B "RTN","RCDPRSEA",150,0) W !," For the Date Range: "_RCRPRT("HdrFrom")_" to "_RCRPRT("HdrTo") "RTN","RCDPRSEA",151,0) S B=" Searching for: "_$S(RCSRCH=1:"CHECK ",RCSRCH=2:"CREDIT CARD ",RCSRCH=3:"TRACE # ",1:"ALL TYPES") "RTN","RCDPRSEA",152,0) S B=B_$S(RCSRCH("type")="E":" EQUAL",1:" CONTAIN")_$S(RCSRCH<4:"S",1:"ING")_" " ; handle plurals "RTN","RCDPRSEA",153,0) S B=B_$C(34)_RCTRGT($$SBSCRPT(RCSRCH))_$C(34) "RTN","RCDPRSEA",154,0) W !,B "RTN","RCDPRSEA",155,0) W !,"Receipt Open Date Trans Account Amount" "RTN","RCDPRSEA",156,0) W !," "_$S(RCSRCH=1:"Check #",RCSRCH=2:"Credit Card #",RCSRCH=3:"Trace #",1:"Any #") "RTN","RCDPRSEA",157,0) W !,$TR($J(" ",80)," ","=") ; 80 equal signs "RTN","RCDPRSEA",158,0) Q "RTN","RCDPRSEA",159,0) ; "RTN","RCDPRSEA",160,0) TRACE(RC344ZRO) ; Return trace # for receipt, RC344ZRO - zero node from file #344 "RTN","RCDPRSEA",161,0) N P "RTN","RCDPRSEA",162,0) S P=+$P(RC344ZRO,U,18) I P Q $P($G(^RCY(344.4,P,0)),U,2) ; (#.18) ERA REFERENCE [18P:344.4] > 344.4,(#.02) TRACE NUMBER [2F] "RTN","RCDPRSEA",163,0) S P=+$P(RC344ZRO,U,17) I P Q $P($G(^RCY(344.31,P,0)),U,4) ; (#.17) EFT RECORD [17P:344.31] > 344.31,(#.04) TRACE # [4F] "RTN","RCDPRSEA",164,0) Q "" ; no trace # found "RTN","RCDPRSEA",165,0) ; "RTN","RCDPRSEA",166,0) ASKSEA() ; ask search field "RTN","RCDPRSEA",167,0) N DIR,DIRUT,DTOUT,DUOUT,X,Y "RTN","RCDPRSEA",168,0) S DIR(0)="SAO^1:Check;2:Credit Card;3:Trace #;4:All" "RTN","RCDPRSEA",169,0) S DIR("A")="Search for Check, Trace, Credit Card #, or All: " "RTN","RCDPRSEA",170,0) S DIR("B")="All" "RTN","RCDPRSEA",171,0) D ^DIR "RTN","RCDPRSEA",172,0) I $G(DTOUT)!($G(DUOUT)) S Y=-1 "RTN","RCDPRSEA",173,0) Q Y "RTN","RCDPRSEA",174,0) ; "RTN","RCDPRSEA",175,0) ASK4ALL() ; Ask the ePayments trace value for ALL types, returns '^' on null or timeout "RTN","RCDPRSEA",176,0) N DIR,X,Y "RTN","RCDPRSEA",177,0) S DIR(0)="FAO^3:50" "RTN","RCDPRSEA",178,0) S DIR("A",1)="Enter the check, credit card, or trace number to Search for" "RTN","RCDPRSEA",179,0) S DIR("A")="in All types: " "RTN","RCDPRSEA",180,0) S DIR("?")="Enter a search number, 3 to 50 characters free text." "RTN","RCDPRSEA",181,0) D ^DIR "RTN","RCDPRSEA",182,0) I $G(DTOUT)!($G(DUOUT)) S Y=U "RTN","RCDPRSEA",183,0) Q $S(Y'="":$$UP(Y),1:U) "RTN","RCDPRSEA",184,0) ; "RTN","RCDPRSEA",185,0) ASK2CONT() ; Boolean function, ask user if they want to search again "RTN","RCDPRSEA",186,0) ; returns 1 if user wants a new search, else zero "RTN","RCDPRSEA",187,0) N DIR,DTOUT,DUOUT,X,Y "RTN","RCDPRSEA",188,0) S RCRTRN=0,DIR(0)="YA",DIR("A")="Would you like to perform another search? " "RTN","RCDPRSEA",189,0) S DIR("A",1)=" " "RTN","RCDPRSEA",190,0) S DIR("A",2)="You can search for "_$C(34)_RCTRGT($$SBSCRPT(RCSRCH("PrevType")))_$C(34)_" in another kind of search." "RTN","RCDPRSEA",191,0) S DIR("A",3)=" " "RTN","RCDPRSEA",192,0) S DIR("?")="Enter 'YES' to search again using the same ePayments values.",DIR("B")="NO" "RTN","RCDPRSEA",193,0) D ^DIR "RTN","RCDPRSEA",194,0) Q $S(X[U!$D(DUOUT)!$D(DTOUT)!'Y:0,1:1) "RTN","RCDPRSEA",195,0) ; "RTN","RCDPRSEA",196,0) ASKDUP() ; Boolean function, ask user if they wish to include trace numbers ending in "-DUPn" "RTN","RCDPRSEA",197,0) ; returns 1 if user wants to include duplicate trace#, else zero "RTN","RCDPRSEA",198,0) N DIR,DTOUT,DUOUT,X,Y "RTN","RCDPRSEA",199,0) S RCRTRN=0,DIR(0)="YA",DIR("A")="Include Duplicate Trace#s: " "RTN","RCDPRSEA",200,0) S DIR("A",1)="If a trace number is greater than 45 characters and a duplicated ERA is" "RTN","RCDPRSEA",201,0) S DIR("A",2)="received, the trace number may be shortened, so that -DUP can be added" "RTN","RCDPRSEA",202,0) S DIR("A",3)="to the end. Answering yes, will cause these trace numbers to be included" "RTN","RCDPRSEA",203,0) S DIR("A",4)="in the search results." "RTN","RCDPRSEA",204,0) S DIR("A",5)=" " "RTN","RCDPRSEA",205,0) S DIR("?")="Enter 'YES' to include duplicate trace numbers.",DIR("B")="NO" D ^DIR "RTN","RCDPRSEA",206,0) Q $S(X[U!$D(DUOUT)!$D(DTOUT):-1,1:+Y) "RTN","RCDPRSEA",207,0) ; "RTN","RCDPRSEA",208,0) CHKTRACE(TYPE,TRACE,TARGET,DUP) ; Check if Trace# is a match "RTN","RCDPRSEA",209,0) ; Input: TYPE - Type of search E=equals, C=CONTAINS "RTN","RCDPRSEA",210,0) ; TRACE - TRACE# from receipt "RTN","RCDPRSEA",211,0) ; TARGET - String user is searching for "RTN","RCDPRSEA",212,0) ; DUP - 1 - include duplicates, otherwise 0. "RTN","RCDPRSEA",213,0) ; Output: 1 - trace number matches the target, otherwise 0. "RTN","RCDPRSEA",214,0) ; "RTN","RCDPRSEA",215,0) N FOUND,X "RTN","RCDPRSEA",216,0) I TYPE="E",TRACE=TARGET Q 1 ;equals "RTN","RCDPRSEA",217,0) I TYPE="C",TRACE[TARGET Q 1 ;contains "RTN","RCDPRSEA",218,0) I RCDUP S FOUND=0 D I FOUND Q 1 ; Include duplicates "RTN","RCDPRSEA",219,0) . I TRACE'["-DUP" Q ; not a duplicate "RTN","RCDPRSEA",220,0) . S X=$P(TRACE,"-DUP",1) "RTN","RCDPRSEA",221,0) . I TYPE="E",X=$E(TARGET,1,$L(X)) S FOUND=1 "RTN","RCDPRSEA",222,0) . I TYPE="C",X[$E(TARGET,1,$L(X)) S FOUND=1 "RTN","RCDPRSEA",223,0) Q 0 "RTN","RCDPRSEA",224,0) ; "RTN","RCDPRSEA",225,0) ; return subscript for search type, if type is 4 all search targets are the same "RTN","RCDPRSEA",226,0) SBSCRPT(X) Q $S(X=1:"Check#",X=2:"CredCard",1:"Trace#") "RTN","RCDPRSEA",227,0) ; function, uppercase "RTN","RCDPRSEA",228,0) UP(T) Q $TR(T,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ") "RTN","RCP332") 0^^B12721543 "RTN","RCP332",1,0) RCP332 ;AITC/CJE,hrubovcak - ePayment Lockbox Post-Installation Processing ;4 Oct 2018 10:29:18 "RTN","RCP332",2,0) ;;4.5;Accounts Receivable;**332**;Oct 4, 2018;Build 40 "RTN","RCP332",3,0) ;Per VA Directive 6402, this routine should not be modified. "RTN","RCP332",4,0) Q "RTN","RCP332",5,0) ; "RTN","RCP332",6,0) POST ; "RTN","RCP332",7,0) N RCMSG,X,Y "RTN","RCP332",8,0) D BMES^XPDUTL("PRCA*4.5*332 post-installation work "_$$HTE^XLFDT($H)) ; add date/time to log "RTN","RCP332",9,0) ; "RTN","RCP332",10,0) ;(#.13) TRICARE EFT POST PREVENT DAYS [13N] update is idempotent if value is in-bounds "RTN","RCP332",11,0) S RCMSG="TRICARE EFT POST PREVENT DAYS" D ; RCMSG holds action performed "RTN","RCP332",12,0) . S X(344.61,0)=$G(^RCY(344.61,1,0)),Y=$P(X(344.61,0),U,13),RCMSG("prev")=Y "RTN","RCP332",13,0) . ; minimum is 14 days, maximum is 60 "RTN","RCP332",14,0) . I (Y>13)&(Y<61) S RCMSG=RCMSG_" value is "_Y_" days. No action taken." K RCMSG("prev") Q ; minimum is 14 days, maximum is 60 "RTN","RCP332",15,0) . L +^RCY(344.61,1):DILOCKTM E D Q ; exclusive access "RTN","RCP332",16,0) .. S RCMSG="Error, unable to update "_RCMSG_" Cannot LOCK entry." "RTN","RCP332",17,0) . ; set default to 30 "RTN","RCP332",18,0) . N RCFDA,RCFMERR "RTN","RCP332",19,0) . S RCFDA(344.61,"1,",.13)=30 ; only 1 entry in 344.61 "RTN","RCP332",20,0) . D FILE^DIE("","RCFDA","RCFMERR") "RTN","RCP332",21,0) . I $D(RCFMERR) D Q ; handle FileMan error "RTN","RCP332",22,0) .. S RCMSG=RCMSG_" not updated due to error." "RTN","RCP332",23,0) .. S X="RCFMERR" F S X=$Q(@X) Q:X="" S Y=@X D BMES^XPDUTL(Y) ; put error text into log "RTN","RCP332",24,0) . S X(344.61,0)=$G(^RCY(344.61,1,0)),Y=+$P(X(344.61,0),U,13) "RTN","RCP332",25,0) . L -^RCY(344.61,1) S RCMSG=RCMSG_" set to "_Y_" days." "RTN","RCP332",26,0) ; "RTN","RCP332",27,0) K X,Y D BMES^XPDUTL(RCMSG) "RTN","RCP332",28,0) D:$D(RCMSG("prev")) MES^XPDUTL("The previous value was "_$C(34)_RCMSG("prev")_$C(34)_".") "RTN","RCP332",29,0) ; end TRICARE EFT POST PREVENT DAYS update "RTN","RCP332",30,0) ; "RTN","RCP332",31,0) ; (#.07) PHARMACY EFT POST PREVENT DAYS [7N] update is idempotent if value null or in-bounds "RTN","RCP332",32,0) K RCMSG "RTN","RCP332",33,0) S RCMSG="PHARMACY EFT POST PREVENT DAYS" D ; RCMSG holds action performed "RTN","RCP332",34,0) . S X(344.61,0)=$G(^RCY(344.61,1,0)),Y=$P(X(344.61,0),U,7),RCMSG("prev")=Y "RTN","RCP332",35,0) . I Y="" S RCMSG=RCMSG_" value has not been entered. No action taken." Q ; field is null, nothing to do "RTN","RCP332",36,0) . I (Y>20)&(Y<100) S RCMSG=RCMSG_" value is "_Y_" days. No action taken." K RCMSG("prev") Q ; minimum is 21 days, maximum is 99 "RTN","RCP332",37,0) . L +^RCY(344.61,1):DILOCKTM E D Q ; exclusive access "RTN","RCP332",38,0) .. S RCMSG="Error, unable to update "_RCMSG_" Cannot LOCK entry." "RTN","RCP332",39,0) . ; value is out-of-bounds, fix it "RTN","RCP332",40,0) . N RCFDA,RCFMERR "RTN","RCP332",41,0) . S RCFDA(344.61,"1,",.07)=$S(Y<21:21,1:99) ; only 1 entry in 344.61 "RTN","RCP332",42,0) . D FILE^DIE("","RCFDA","RCFMERR") "RTN","RCP332",43,0) . I $D(RCFMERR) D Q ; handle FileMan error "RTN","RCP332",44,0) .. S RCMSG=RCMSG_" not updated due to error." "RTN","RCP332",45,0) .. S X="RCFMERR" F S X=$Q(@X) Q:X="" S Y=@X D BMES^XPDUTL(Y) ; put error text into log "RTN","RCP332",46,0) . S X(344.61,0)=$G(^RCY(344.61,1,0)),Y=+$P(X(344.61,0),U,7) "RTN","RCP332",47,0) . L -^RCY(344.61,1) S RCMSG=RCMSG_" set to "_Y_" days." "RTN","RCP332",48,0) ; "RTN","RCP332",49,0) K X,Y D:$L(RCMSG) BMES^XPDUTL(RCMSG) ; if RCMSG null nothing was updated "RTN","RCP332",50,0) D:$D(RCMSG("prev")) MES^XPDUTL("The previous value was "_$C(34)_RCMSG("prev")_$C(34)_".") "RTN","RCP332",51,0) ; end PHARMACY EFT POST PREVENT DAYS update "RTN","RCP332",52,0) ; "RTN","RCP332",53,0) D BMES^XPDUTL("Fixing ERA numbers...") "RTN","RCP332",54,0) D FIX3444 "RTN","RCP332",55,0) ; "RTN","RCP332",56,0) D BMES^XPDUTL("PRCA*4.5*332 post-installation finished "_$$HTE^XLFDT($H)) "RTN","RCP332",57,0) Q "RTN","RCP332",58,0) ; "RTN","RCP332",59,0) ; "RTN","RCP332",60,0) FIX3444 ; Repair Internal Entry Numbers in 344.4 where IEN is not equal to .01 "RTN","RCP332",61,0) N IEN,ENTRY "RTN","RCP332",62,0) S IEN=0 "RTN","RCP332",63,0) F S IEN=$O(^RCY(344.4,IEN)) Q:'IEN D ; "RTN","RCP332",64,0) . S ENTRY=$P($G(^RCY(344.4,IEN,0)),"^",1) "RTN","RCP332",65,0) . I 'ENTRY Q "RTN","RCP332",66,0) . I ENTRY'=IEN D ; "RTN","RCP332",67,0) . . N FDA "RTN","RCP332",68,0) . . S FDA(344.4,IEN_",",.01)=IEN "RTN","RCP332",69,0) . . D FILE^DIE("","FDA") "RTN","RCP332",70,0) Q "UP",344.61,344.611,-1) 344.61^2 "UP",344.61,344.611,0) 344.611 "VER") 8.0^22.2 "^DD",342,342,7.09,0) AUTO-AUDIT TRICARE BILLS^S^0:No;1:Yes;^7;9^Q "^DD",342,342,7.09,.1) ENABLE AUTO-AUDIT TRICARE BILLS "^DD",342,342,7.09,3) Enter 1 to allow auto-auditing of Tricare Bills, 0 to disallow. "^DD",342,342,7.09,21,0) ^.001^2^2^3181101^^^^ "^DD",342,342,7.09,21,1,0) A Yes/No prompt to allow a site to audit their Tricare Bills during "^DD",342,342,7.09,21,2,0) the AR Nightly Process. "^DD",342,342,7.09,23,0) ^.001^2^2^3181101^^^^ "^DD",342,342,7.09,23,1,0) A Yes/No prompt to indicate if the site wishes to audit their Tricare "^DD",342,342,7.09,23,2,0) bills during the AR Nightly Process [PRCA NIGHTLY PROCESS]. "^DD",342,342,7.09,"DT") 3181120 "^DD",344.5,344.5,.15,0) DUPLICATE INDICATOR^S^0:NO;1:YES;^0;15^Q "^DD",344.5,344.5,.15,3) Enter '1' if the message is a duplicate transmission. "^DD",344.5,344.5,.15,21,0) ^.001^1^1^3180820^^^^ "^DD",344.5,344.5,.15,21,1,0) This field indicates the incoming 835 message is a duplicate transmission. "^DD",344.5,344.5,.15,23,0) ^^3^3^3180820^ "^DD",344.5,344.5,.15,23,1,0) This field is used in the filing routines for EFT 835 messages "^DD",344.5,344.5,.15,23,2,0) to override the checks for duplicates. The field will be automatically "^DD",344.5,344.5,.15,23,3,0) set by the system. "^DD",344.5,344.5,.15,"DT") 3181017 "^DD",344.61,344.61,.07,0) PHARMACY EFT POST PREVENT DAYS^NJ2,0^^0;7^K:+X'=X!(X>99)!(X<21)!(X?.E1"."1N.N) X "^DD",344.61,344.61,.07,.1) NUMBER OF DAYS (AGE) OF UNPOSTED PHARMACY EFTS TO PREVENT POSTING: "^DD",344.61,344.61,.07,3) Enter a number from 21 to 99 inclusive, 0 decimal digits. "^DD",344.61,344.61,.07,21,0) ^.001^6^6^3181004^^^ "^DD",344.61,344.61,.07,21,1,0) The number of calendar days beyond which unposted pharmacy payments "^DD",344.61,344.61,.07,21,2,0) (EFTs) will prevent the user from posting newer pharmacy EFTs without "^DD",344.61,344.61,.07,21,3,0) posting the older payments first. "^DD",344.61,344.61,.07,21,4,0) "^DD",344.61,344.61,.07,21,5,0) The user can reset the value to a number between 21 and 99, inclusive, "^DD",344.61,344.61,.07,21,6,0) but the user cannot delete the value. "^DD",344.61,344.61,.07,"DEL",1,0) I 1 D EN^DDIOL($C(7)_"This value cannot be deleted!") "^DD",344.61,344.61,.07,"DT") 3181004 "^DD",344.61,344.61,.13,0) TRICARE EFT POST PREVENT DAYS^NJ2,0^^0;13^K:+X'=X!(X>60)!(X<14)!(X?.E1"."1N.N) X "^DD",344.61,344.61,.13,.1) NUMBER OF DAYS (AGE) OF UNPOSTED TRICARE EFTS TO PREVENT POSTING: "^DD",344.61,344.61,.13,3) Enter the number of days an EFT can age before preventing newer EFTs (between 14 and 60). "^DD",344.61,344.61,.13,21,0) ^.001^6^6^3180927^^ "^DD",344.61,344.61,.13,21,1,0) The number of calendar days beyond which un-posted Tricare "^DD",344.61,344.61,.13,21,2,0) payments (EFTs) will prevent the user from posting newer "^DD",344.61,344.61,.13,21,3,0) medical EFTs without posting the older payments first. "^DD",344.61,344.61,.13,21,4,0) "^DD",344.61,344.61,.13,21,5,0) A value of 30 is the initial default. The user can set the value to a number "^DD",344.61,344.61,.13,21,6,0) from 14 to 60, inclusive, but cannot delete the value. "^DD",344.61,344.61,.13,23,0) ^^1^1^3180927^ "^DD",344.61,344.61,.13,23,1,0) This field has a "DEL" node to prevent deletion. "^DD",344.61,344.61,.13,"DEL",1,0) I 1 D EN^DDIOL($C(7)_"This value cannot be deleted!") "^DD",344.61,344.61,.13,"DT") 3181120 "^DD",344.61,344.61,2,0) HISTORY^344.611D^^2;0 "^DD",344.61,344.61,2,21,0) ^^5^5^3181017^ "^DD",344.61,344.61,2,21,1,0) The history multiple contains a log of changes to EDI Lockbox auto-post "^DD",344.61,344.61,2,21,2,0) and auto-decrease parameters. The date and time of the change, the user "^DD",344.61,344.61,2,21,3,0) who made the change and the old and new values of the parameter are "^DD",344.61,344.61,2,21,4,0) stored. This information is used to print the Auto Parameter History "^DD",344.61,344.61,2,21,5,0) Report on demand. "^DD",344.61,344.61,26,0) TRICARE EFT OVERRIDE^D^^OVERRIDE;7^S %DT="ESTX" D ^%DT S X=Y K:Y<1 X "^DD",344.61,344.61,26,3) Enter the precise date (optional time) recorded for the Tricare EFT override. "^DD",344.61,344.61,26,21,0) ^^2^2^3180927^ "^DD",344.61,344.61,26,21,1,0) An override will allow unrestricted scratchpad creation within "^DD",344.61,344.61,26,21,2,0) the ERA Worklist option for one day. "^DD",344.61,344.61,26,"DT") 3180927 "^DD",344.61,344.61,27,0) USER - TRICARE OVERRIDE^P200'^VA(200,^OVERRIDE;8^Q "^DD",344.61,344.61,27,.1) USER WHO ENTERED THE TRICARE OVERRIDE "^DD",344.61,344.61,27,3) Enter the user who entered the Tricare override. "^DD",344.61,344.61,27,21,0) ^^2^2^3180927^ "^DD",344.61,344.61,27,21,1,0) A record of the person who entered the Tricare override is needed for "^DD",344.61,344.61,27,21,2,0) auditing purposes. "^DD",344.61,344.61,27,"DT") 3180927 "^DD",344.61,344.61,28,0) COMMENT - TRICARE OVERRIDE^FJ50^^OVERRIDE;9^K:$L(X)>50!($L(X)<1) X "^DD",344.61,344.61,28,.1) COMMENT EXPLAINING THE TRICARE OVERRIDE "^DD",344.61,344.61,28,3) Enter the reason for the Tricare override, 1-50 characters. "^DD",344.61,344.61,28,21,0) ^^2^2^3180927^ "^DD",344.61,344.61,28,21,1,0) The reason for entering the Tricare override must be recorded "^DD",344.61,344.61,28,21,2,0) for auditing purposes. "^DD",344.61,344.61,28,"DT") 3180927 "^DD",344.61,344.611,0) HISTORY SUB-FIELD^^4^6 "^DD",344.61,344.611,0,"NM","HISTORY") "^DD",344.61,344.611,.01,0) DATE^MMD^^0;1^S %DT="ESTX" D ^%DT S X=Y K:X<1 X "^DD",344.61,344.611,.01,1,0) ^.1 "^DD",344.61,344.611,.01,1,1,0) 344.611^B "^DD",344.61,344.611,.01,1,1,1) S ^RCY(344.61,DA(1),2,"B",$E(X,1,30),DA)="" "^DD",344.61,344.611,.01,1,1,2) K ^RCY(344.61,DA(1),2,"B",$E(X,1,30),DA) "^DD",344.61,344.611,.01,3) Enter the date/time the EDI Lockbox parameter was changed. "^DD",344.61,344.611,.01,21,0) ^^1^1^3180720^ "^DD",344.61,344.611,.01,21,1,0) This field will be automatically populated by the system. "^DD",344.61,344.611,.01,"DT") 3180730 "^DD",344.61,344.611,.02,0) USER^P200'^VA(200,^0;2^Q "^DD",344.61,344.611,.02,3) Enter the person who changed the EDI Lockbox parameter "^DD",344.61,344.611,.02,21,0) ^^1^1^3180720^ "^DD",344.61,344.611,.02,21,1,0) This field will be automatically populated by the system. "^DD",344.61,344.611,.02,"DT") 3180730 "^DD",344.61,344.611,1,0) PARAMETER^FJ50^^0;3^K:$L(X)>50!($L(X)<1) X "^DD",344.61,344.611,1,3) Enter the description of the parameter that was changed, 1 to 50 characters. "^DD",344.61,344.611,1,21,0) ^^1^1^3181017^ "^DD",344.61,344.611,1,21,1,0) This field will be automatically populated by the system. "^DD",344.61,344.611,1,"DT") 3181017 "^DD",344.61,344.611,2,0) DETAIL^FJ60^^0;4^K:$L(X)>60!($L(X)<1) X "^DD",344.61,344.611,2,3) Enter the payer or CARC code associated with this change, 1 to 60 characters. "^DD",344.61,344.611,2,21,0) ^^1^1^3180720^^ "^DD",344.61,344.611,2,21,1,0) This field will be automatically populated by the system. "^DD",344.61,344.611,2,"DT") 3181017 "^DD",344.61,344.611,3,0) OLD VALUE^FJ20^^0;5^K:$L(X)>20!($L(X)<1) X "^DD",344.61,344.611,3,3) Enter the old value of the parameter that was changed, 1 to 20 characters. "^DD",344.61,344.611,3,21,0) ^^1^1^3180720^^ "^DD",344.61,344.611,3,21,1,0) This field will be automatically populated by the system. "^DD",344.61,344.611,3,"DT") 3181017 "^DD",344.61,344.611,4,0) NEW VALUE^FJ20^^0;6^K:$L(X)>20!($L(X)<1) X "^DD",344.61,344.611,4,3) Enter the new value of the parameter that was changed, 1 to 20 characters. "^DD",344.61,344.611,4,21,0) ^^1^1^3180720^ "^DD",344.61,344.611,4,21,1,0) This field will be automatically populated by the system. "^DD",344.61,344.611,4,"DT") 3181017 **INSTALL NAME** IB*2.0*633 "BLD",11068,0) IB*2.0*633^INTEGRATED BILLING^0^3190606^y "BLD",11068,4,0) ^9.64PA^^ "BLD",11068,6.3) 21 "BLD",11068,"KRN",0) ^9.67PA^779.2^20 "BLD",11068,"KRN",.4,0) .4 "BLD",11068,"KRN",.401,0) .401 "BLD",11068,"KRN",.402,0) .402 "BLD",11068,"KRN",.403,0) .403 "BLD",11068,"KRN",.5,0) .5 "BLD",11068,"KRN",.84,0) .84 "BLD",11068,"KRN",3.6,0) 3.6 "BLD",11068,"KRN",3.8,0) 3.8 "BLD",11068,"KRN",9.2,0) 9.2 "BLD",11068,"KRN",9.8,0) 9.8 "BLD",11068,"KRN",9.8,"NM",0) ^9.68A^4^4 "BLD",11068,"KRN",9.8,"NM",1,0) IBCEOB0^^0^B98733929 "BLD",11068,"KRN",9.8,"NM",2,0) IBJTEP^^0^B170521408 "BLD",11068,"KRN",9.8,"NM",3,0) IBJTEP1^^0^B58092745 "BLD",11068,"KRN",9.8,"NM",4,0) IBJTPE^^0^B134610496 "BLD",11068,"KRN",9.8,"NM","B","IBCEOB0",1) "BLD",11068,"KRN",9.8,"NM","B","IBJTEP",2) "BLD",11068,"KRN",9.8,"NM","B","IBJTEP1",3) "BLD",11068,"KRN",9.8,"NM","B","IBJTPE",4) "BLD",11068,"KRN",19,0) 19 "BLD",11068,"KRN",19.1,0) 19.1 "BLD",11068,"KRN",101,0) 101 "BLD",11068,"KRN",409.61,0) 409.61 "BLD",11068,"KRN",771,0) 771 "BLD",11068,"KRN",779.2,0) 779.2 "BLD",11068,"KRN",870,0) 870 "BLD",11068,"KRN",8989.51,0) 8989.51 "BLD",11068,"KRN",8989.52,0) 8989.52 "BLD",11068,"KRN",8994,0) 8994 "BLD",11068,"KRN","B",.4,.4) "BLD",11068,"KRN","B",.401,.401) "BLD",11068,"KRN","B",.402,.402) "BLD",11068,"KRN","B",.403,.403) "BLD",11068,"KRN","B",.5,.5) "BLD",11068,"KRN","B",.84,.84) "BLD",11068,"KRN","B",3.6,3.6) "BLD",11068,"KRN","B",3.8,3.8) "BLD",11068,"KRN","B",9.2,9.2) "BLD",11068,"KRN","B",9.8,9.8) "BLD",11068,"KRN","B",19,19) "BLD",11068,"KRN","B",19.1,19.1) "BLD",11068,"KRN","B",101,101) "BLD",11068,"KRN","B",409.61,409.61) "BLD",11068,"KRN","B",771,771) "BLD",11068,"KRN","B",779.2,779.2) "BLD",11068,"KRN","B",870,870) "BLD",11068,"KRN","B",8989.51,8989.51) "BLD",11068,"KRN","B",8989.52,8989.52) "BLD",11068,"KRN","B",8994,8994) "BLD",11068,"QUES",0) ^9.62^^ "BLD",11068,"REQB",0) ^9.611^2^2 "BLD",11068,"REQB",1,0) IB*2.0*516^1 "BLD",11068,"REQB",2,0) IB*2.0*609^1 "BLD",11068,"REQB","B","IB*2.0*516",1) "BLD",11068,"REQB","B","IB*2.0*609",2) "MBREQ") 0 "PKG",230,-1) 1^1 "PKG",230,0) INTEGRATED BILLING^IB^INTEGRATED BILLING "PKG",230,22,0) ^9.49I^1^1 "PKG",230,22,1,0) 2.0^2940321^2940525 "PKG",230,22,1,"PAH",1,0) 633^3190606^520824650 "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") 4 "RTN","IBCEOB0") 0^1^B98733929 "RTN","IBCEOB0",1,0) IBCEOB0 ;ALB/TMP/PJH - 835 EDI EOB MSG PROCESSING ; 8/24/10 7:23pm "RTN","IBCEOB0",2,0) ;;2.0;INTEGRATED BILLING;**135,280,155,431,488,516,633**;21-MAR-94;Build 21 "RTN","IBCEOB0",3,0) ;;Per VA Directive 6402, this routine should not be modified. "RTN","IBCEOB0",4,0) Q "RTN","IBCEOB0",5,0) ; "RTN","IBCEOB0",6,0) LINE() ;Extract Provider Line Reference from 42 record "RTN","IBCEOB0",7,0) N SUB,NODE,VAL "RTN","IBCEOB0",8,0) S VAL="",SUB=IBA1 ; from loop in UPD3611^IBCEOB "RTN","IBCEOB0",9,0) ;IB*2.0*516/TAZ - Quit when another RT 40 is encountered to prevent group of "RTN","IBCEOB0",10,0) ;mismatched procedures "RTN","IBCEOB0",11,0) F S SUB=$O(@IBFILE@(SUB)) Q:SUB="" D Q:(+NODE>42)!(+NODE=40) "RTN","IBCEOB0",12,0) .S NODE=$G(@IBFILE@(SUB,0)) "RTN","IBCEOB0",13,0) .S:NODE["RAW DATA" NODE=$P(NODE," ",3,99) "RTN","IBCEOB0",14,0) .Q:+NODE'=42 S VAL=$P(NODE,U,5) "RTN","IBCEOB0",15,0) Q VAL "RTN","IBCEOB0",16,0) ; "RTN","IBCEOB0",17,0) 30(IB0,IBEOB,IBOK) ; Process record type 30 for EOB "RTN","IBCEOB0",18,0) ; IB0 = the record being processed "RTN","IBCEOB0",19,0) ; IBEOB = the ien of the EOB entry in file 361.1 "RTN","IBCEOB0",20,0) ; IBOK = Returned as 1 if record filed OK, 0 if error occurred "RTN","IBCEOB0",21,0) ; "RTN","IBCEOB0",22,0) N A "RTN","IBCEOB0",23,0) S A="3;4.01;0;1;1^5;4.02;0;1;1^6;4.03;1;0;0^7;4.05;1;0;0^8;4.06;1;0;0^9;4.07;1;0;0^10;4.08;1;0;0^11;4.09;1;0;0^12;4.1;1;0;0^13;4.11;1;0;0^14;4.19;0;1;1" "RTN","IBCEOB0",24,0) ; "RTN","IBCEOB0",25,0) S IBOK=$$STORE^IBCEOB1(A,IB0,IBEOB) "RTN","IBCEOB0",26,0) I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Bad MEDICARE Inpt Adjudication data" "RTN","IBCEOB0",27,0) Q30 Q "RTN","IBCEOB0",28,0) ; "RTN","IBCEOB0",29,0) 40(IB0,IBEOB,IBOK) ; Process record type 40 for EOB "RTN","IBCEOB0",30,0) ; IB0 = the record being processed "RTN","IBCEOB0",31,0) ; IBEOB = the ien of the EOB entry in file 361.1 "RTN","IBCEOB0",32,0) ; IBOK = Returned as 1 if record filed OK, 0 if error occurred "RTN","IBCEOB0",33,0) ; "RTN","IBCEOB0",34,0) ; IBZDATA is also assumed to exist or if not, it is created in FINDLN "RTN","IBCEOB0",35,0) ; "RTN","IBCEOB0",36,0) N A,LEVEL,IBSEQ,IBDA,IBPC,IBLREF,IBIFN,Q,X,Y,DA,DD,DO,DIC,DLAYGO,PLREF,ERRCOD "RTN","IBCEOB0",37,0) K ^TMP($J,40) ; the entry # for corresponding 41, 42, and 45 records "RTN","IBCEOB0",38,0) ; "RTN","IBCEOB0",39,0) S IBIFN=+$G(^IBM(361.1,IBEOB,0)) "RTN","IBCEOB0",40,0) L +^IBM(361.1,IBEOB,15):0 I $T S IBSEQ=+$O(^IBM(361.1,IBEOB,15," "),-1)+1 "RTN","IBCEOB0",41,0) I '$G(IBSEQ) S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Record lock failure - could not acquire next service line number" G Q40 "RTN","IBCEOB0",42,0) ; "RTN","IBCEOB0",43,0) ; Update the 40 record data a little bit (pieces 3/4/16) "RTN","IBCEOB0",44,0) I $P(IB0,U,21)="NU" S $P(IB0,U,4)=$P(IB0,U,3),$P(IB0,U,3)="" "RTN","IBCEOB0",45,0) S $P(IB0,U,16)=$S(+$P(IB0,U,16):$P(IB0,U,16)/100,1:+$P(IB0,U,18)/100) "RTN","IBCEOB0",46,0) I $P(IB0,U,4)?1.N S $P(IB0,U,4)=+$P(IB0,U,4) "RTN","IBCEOB0",47,0) ; "RTN","IBCEOB0",48,0) ; Find the line item from original bill for this adjustment "RTN","IBCEOB0",49,0) S PLREF=$S('HIPAA:$P(IB0,U,22),1:$$LINE()) ; old format from 40 record, new format from 42 "RTN","IBCEOB0",50,0) S ERRCOD=0 "RTN","IBCEOB0",51,0) S IBLREF=+$$FINDLN^IBCEOB1(IB0,IBEOB,.IBZDATA,+PLREF,.ERRCOD) "RTN","IBCEOB0",52,0) I 'IBLREF D G Q40 "RTN","IBCEOB0",53,0) . N Z,Z0,CT,ETEXT "RTN","IBCEOB0",54,0) . S EFLAG=0,ETEXT="" "RTN","IBCEOB0",55,0) . ;;S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Service line detail could not be matched to a billed item" "RTN","IBCEOB0",56,0) . S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)=" " "RTN","IBCEOB0",57,0) . S ETEXT=$P("Revenue Code^Procedure Code^Amount of Units^Charge Amount^Procedure Code Modifier",U,+ERRCOD) "RTN","IBCEOB0",58,0) . I ETEXT="" S ETEXT="Data" "RTN","IBCEOB0",59,0) . S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)=$$ERRTXT(ETEXT,IBEOB) ; IB*2.0*633 "RTN","IBCEOB0",60,0) . S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)=" " "RTN","IBCEOB0",61,0) . D DET40^IBCEOB00(IB0,.Z0,ERRCOD) "RTN","IBCEOB0",62,0) . S CT=+$O(^TMP(IBEGBL,$J,""),-1),Z=0 F S Z=$O(Z0(Z)) Q:'Z S CT=CT+1,^TMP(IBEGBL,$J,CT)=Z0(Z) "RTN","IBCEOB0",63,0) ; "RTN","IBCEOB0",64,0) S DIC="^IBM(361.1,"_IBEOB_",15,",DIC(0)="L",DLAYGO=361.115,DA(1)=IBEOB "RTN","IBCEOB0",65,0) S X=IBSEQ "RTN","IBCEOB0",66,0) S DIC("DR")=".12////"_+IBLREF_$S($P(IBLREF,U,2)="":"",1:";.15////"_$P(IBLREF,U,2))_";.16////"_$$DATE^IBCEU($P(IB0,U,19))_$S($P(IB0,U,20):";.17////"_$$DATE^IBCEU($P(IB0,U,20)),1:"") "RTN","IBCEOB0",67,0) D FILE^DICN K DIC,DO,DD,DLAYGO ;Add a new LINE LEVEL ADJUSTMENT ('SVC') "RTN","IBCEOB0",68,0) I Y<0 S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Could not add a LINE LEVEL ADJUSTMENT ("_IBSEQ_")" G Q40 "RTN","IBCEOB0",69,0) ; "RTN","IBCEOB0",70,0) L -^IBM(361.1,IBEOB,15) "RTN","IBCEOB0",71,0) ; "RTN","IBCEOB0",72,0) S LEVEL=15.1,LEVEL(0)=+Y,LEVEL(1)=IBEOB,LEVEL("DIE")="^IBM(361.1,"_IBEOB_",15," "RTN","IBCEOB0",73,0) S A="3;.04;0;0;0^4;.1;0;0;0^9;.09;0;0;0^17;.03;1;0;0^18;.11;0;1;D2^21;.18;0;0;0" "RTN","IBCEOB0",74,0) I '$P(IB0,U,18),$P(IB0,U,16) S $P(A,U,5)="16;.11;0;1;1" "RTN","IBCEOB0",75,0) I $$STORE^IBCEOB1(A,IB0,IBEOB,.LEVEL) S ^TMP($J,40)=LEVEL(0),IBOK=1 "RTN","IBCEOB0",76,0) I '$G(IBOK) S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Bad data for line level adjustment "_IBSEQ G Q40 "RTN","IBCEOB0",77,0) ; "RTN","IBCEOB0",78,0) ; Store modifiers in multiple "RTN","IBCEOB0",79,0) S DIC="^IBM(361.1,"_IBEOB_",15,"_LEVEL(0)_",2,",DIC(0)="L",DLAYGO=361.1152,DA(2)=IBEOB,DA(1)=LEVEL(0) "RTN","IBCEOB0",80,0) F Q=5:1:8 S X=$P(IB0,U,Q) I X'="" D FILE^DICN K DO,DD I Y<0 S IBOK=0 Q "RTN","IBCEOB0",81,0) K DLAYGO,DIC,DR,DA "RTN","IBCEOB0",82,0) I '$G(IBOK) S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Could not file modifier data for line level adjustment "_IBSEQ G Q40 "RTN","IBCEOB0",83,0) Q40 Q "RTN","IBCEOB0",84,0) ; "RTN","IBCEOB0",85,0) 41(IB0,IBEOB,IBOK) ; Process record type 41 for EOB "RTN","IBCEOB0",86,0) ; IB0 = the record being processed "RTN","IBCEOB0",87,0) ; IBEOB = the ien of the EOB entry in file 361.1 "RTN","IBCEOB0",88,0) ; IBOK = Returned as 1 if record filed OK, 0 if error occurred "RTN","IBCEOB0",89,0) ; "RTN","IBCEOB0",90,0) N DA,DR,DIE,X,Y,Z,Z0,CT "RTN","IBCEOB0",91,0) I '$G(^TMP($J,40)) D G Q41 "RTN","IBCEOB0",92,0) . S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Service line adjustment (EEOB Record 41) has no matching service line" "RTN","IBCEOB0",93,0) . D DET4X^IBCEOB00(41,IB0,.Z0) "RTN","IBCEOB0",94,0) . S CT=+$O(^TMP(IBEGBL,$J,""),-1),Z=0 F S Z=$O(Z0(Z)) Q:'Z S CT=CT+1,^TMP(IBEGBL,$J,CT)=Z0(Z) "RTN","IBCEOB0",95,0) ; "RTN","IBCEOB0",96,0) S DR="",IBOK=1 "RTN","IBCEOB0",97,0) S DA=+^TMP($J,40),DA(1)=IBEOB "RTN","IBCEOB0",98,0) S DIE="^IBM(361.1,"_DA(1)_",15," "RTN","IBCEOB0",99,0) I +$P(IB0,U,3) S DR=".13///"_$$DOLLAR^IBCEOB($P(IB0,U,3)) "RTN","IBCEOB0",100,0) I +$P(IB0,U,4) S DR=DR_$S(DR="":"",1:";")_".14///"_$$DOLLAR^IBCEOB($P(IB0,U,4)) "RTN","IBCEOB0",101,0) I DR'="" D ^DIE S IBOK=($D(Y)=0) "RTN","IBCEOB0",102,0) I '$G(IBOK) S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Mismatched data for service line adjustment-2 (EEOB Record 41)" "RTN","IBCEOB0",103,0) ; "RTN","IBCEOB0",104,0) ; For Medicare MRA's only: "RTN","IBCEOB0",105,0) ; If the Allowed Amount field is present, then we need to file an "RTN","IBCEOB0",106,0) ; adjustment: Group code PR, Reason code AAA, Amount, Quantity, and "RTN","IBCEOB0",107,0) ; Reason Text. This is data normally found on the 45 record, so we're "RTN","IBCEOB0",108,0) ; going to create our own "45" record and file it. "RTN","IBCEOB0",109,0) ; "RTN","IBCEOB0",110,0) I $P($G(^IBM(361.1,IBEOB,0)),U,4)=1,+$P(IB0,U,3) D "RTN","IBCEOB0",111,0) . N IB45,IBSAV40 "RTN","IBCEOB0",112,0) . S IB45=45_U_$P(IB0,U,2)_U_"PR"_U_"AAA"_U_$P(IB0,U,3)_U_"0000000001" "RTN","IBCEOB0",113,0) . S IB45=IB45_U_"Allowed Amount" "RTN","IBCEOB0",114,0) . S IBSAV40=$G(^TMP($J,40)) "RTN","IBCEOB0",115,0) . D 45(IB45,IBEOB,.IBOK) "RTN","IBCEOB0",116,0) . S ^TMP($J,40)=IBSAV40 "RTN","IBCEOB0",117,0) . I '$G(IBOK) S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Could not file the PR-AAA adjustment for the Allowed Amount at line "_+^TMP($J,40) "RTN","IBCEOB0",118,0) . Q "RTN","IBCEOB0",119,0) ; "RTN","IBCEOB0",120,0) Q41 Q "RTN","IBCEOB0",121,0) ; "RTN","IBCEOB0",122,0) 42(IB0,IBEOB,IBOK) ; Process record type 42 for EOB "RTN","IBCEOB0",123,0) ; IB0 = the record being processed "RTN","IBCEOB0",124,0) ; IBEOB = the ien of the EOB entry in file 361.1 "RTN","IBCEOB0",125,0) ; IBOK = Returned as 1 if record filed OK, 0 if error occurred "RTN","IBCEOB0",126,0) ; "RTN","IBCEOB0",127,0) N DO,DD,DLAYGO,DIC,DA,X,Y,Z,Z0,CT "RTN","IBCEOB0",128,0) S IBOK=0 "RTN","IBCEOB0",129,0) I '$G(^TMP($J,40)) D G Q42 "RTN","IBCEOB0",130,0) . S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Service line adjustment (EEOB Record 42) has no matching service line" "RTN","IBCEOB0",131,0) . D DET4X^IBCEOB00(42,IB0,.Z0) "RTN","IBCEOB0",132,0) . S CT=+$O(^TMP(IBEGBL,$J,""),-1),Z=0 F S Z=$O(Z0(Z)) Q:'Z S CT=CT+1,^TMP(IBEGBL,$J,CT)=Z0(Z) "RTN","IBCEOB0",133,0) ; "RTN","IBCEOB0",134,0) K DO,DD,DLAYGO "RTN","IBCEOB0",135,0) S IBOK=1 "RTN","IBCEOB0",136,0) S DA(1)=+^TMP($J,40),DA(2)=IBEOB "RTN","IBCEOB0",137,0) S X=+$O(^IBM(361.1,DA(2),15,DA(1),4," "),-1)+1,DIC="^IBM(361.1,"_DA(2)_",15,"_DA(1)_",4,",DIC(0)="L",DLAYGO=361.1154 "RTN","IBCEOB0",138,0) S DIC("DR")=$S($P(IB0,U,3)'="":".02////"_$P(IB0,U,3),1:"") "RTN","IBCEOB0",139,0) I $P(IB0,U,4)'="" S:$L(DIC("DR")) DIC("DR")=DIC("DR")_";" S DIC("DR")=DIC("DR")_".03////"_$TR($P(IB0,U,4),";"," ") "RTN","IBCEOB0",140,0) D FILE^DICN K DO,DD,DLAYGO "RTN","IBCEOB0",141,0) I Y'>0 S IBOK=0 "RTN","IBCEOB0",142,0) I '$G(IBOK) S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Mismatched data for service line adjustment-3 (EEOB Record 42)" "RTN","IBCEOB0",143,0) ; "RTN","IBCEOB0",144,0) ; For Medicare MRA's only: "RTN","IBCEOB0",145,0) ; Process and store the line level remark code as an LQ kludge line "RTN","IBCEOB0",146,0) ; level adjustment. "RTN","IBCEOB0",147,0) ; "RTN","IBCEOB0",148,0) I $P($G(^IBM(361.1,IBEOB,0)),U,4)=1,$P(IB0,U,3)'="" D "RTN","IBCEOB0",149,0) . N IB45,IBSAV40 "RTN","IBCEOB0",150,0) . S IB45=45_U_$P(IB0,U,2)_U_"LQ"_U_$P(IB0,U,3)_U_0_U_0_U_$P(IB0,U,4) "RTN","IBCEOB0",151,0) . S IBSAV40=$G(^TMP($J,40)) "RTN","IBCEOB0",152,0) . D 45(IB45,IBEOB,.IBOK) "RTN","IBCEOB0",153,0) . S ^TMP($J,40)=IBSAV40 "RTN","IBCEOB0",154,0) . I '$G(IBOK) S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Could not file the LQ-remark code adjustment at line "_+^TMP($J,40) "RTN","IBCEOB0",155,0) . Q "RTN","IBCEOB0",156,0) Q42 Q "RTN","IBCEOB0",157,0) ; "RTN","IBCEOB0",158,0) 45(IB0,IBEOB,IBOK) ; Process record type 45 for EOB "RTN","IBCEOB0",159,0) ; IB0 = the record being processed "RTN","IBCEOB0",160,0) ; IBEOB = the ien of the EOB entry in file 361.1 "RTN","IBCEOB0",161,0) ; IBOK = Returned as 1 if record filed OK, 0 if error occurred "RTN","IBCEOB0",162,0) ; "RTN","IBCEOB0",163,0) N IBDA,LEVEL,A,Z0,CT,Z "RTN","IBCEOB0",164,0) I '$G(^TMP($J,40)) D G Q45 "RTN","IBCEOB0",165,0) . S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Service line adjustment (EEOB Record 45) has no matching service line" "RTN","IBCEOB0",166,0) . D DET4X^IBCEOB00(45,IB0,.Z0) "RTN","IBCEOB0",167,0) . S CT=+$O(^TMP(IBEGBL,$J,""),-1),Z=0 F S Z=$O(Z0(Z)) Q:'Z S CT=CT+1,^TMP(IBEGBL,$J,CT)=Z0(Z) "RTN","IBCEOB0",168,0) ; "RTN","IBCEOB0",169,0) I $P(IB0,U,3)'="" S $P(^TMP($J,40),U,2)=$P(IB0,U,3) "RTN","IBCEOB0",170,0) I $P(IB0,U,3)="" S $P(IB0,U,3)=$P(^TMP($J,40),U,2) "RTN","IBCEOB0",171,0) I $P(IB0,U,3)="" S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Service line adjustment (EEOB Record 45) is missing its group code" G Q45 "RTN","IBCEOB0",172,0) ; "RTN","IBCEOB0",173,0) S IBDA(2)=+^TMP($J,40) "RTN","IBCEOB0",174,0) S IBDA(1)=+$O(^IBM(361.1,IBEOB,15,IBDA(2),1,"B",$P(IB0,U,3),0)) "RTN","IBCEOB0",175,0) ; "RTN","IBCEOB0",176,0) I 'IBDA(1) D ;Needs a new entry at group level "RTN","IBCEOB0",177,0) . N X,Y,DA,DD,DO,DIC,DLAYGO "RTN","IBCEOB0",178,0) . S DIC="^IBM(361.1,"_IBEOB_",15,"_IBDA(2)_",1,",DIC(0)="L",DLAYGO=361.1151,DA(2)=IBEOB,DA(1)=IBDA(2) "RTN","IBCEOB0",179,0) . S DIC("P")=$$GETSPEC^IBEFUNC(361.115,1) "RTN","IBCEOB0",180,0) . S X=$P(IB0,U,3) "RTN","IBCEOB0",181,0) . D FILE^DICN K DIC,DO,DD,DLAYGO "RTN","IBCEOB0",182,0) . I Y<0 K IBDA S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Could not add adjustment group code ("_$P(IB0,U,3)_") at line adjustment "_+^TMP($J,40) Q "RTN","IBCEOB0",183,0) . S IBDA(1)=+Y "RTN","IBCEOB0",184,0) ; "RTN","IBCEOB0",185,0) ;Add a new entry at the reason code level "RTN","IBCEOB0",186,0) I $G(IBDA(1)) D "RTN","IBCEOB0",187,0) . S DIC="^IBM(361.1,"_IBEOB_",15,"_IBDA(2)_",1,"_IBDA(1)_",1,",DIC(0)="L",DLAYGO=361.11511,DA(1)=IBDA(1),DA(2)=IBDA(2),DA(3)=IBEOB "RTN","IBCEOB0",188,0) . S DIC("P")=$$GETSPEC^IBEFUNC(361.1151,1) "RTN","IBCEOB0",189,0) . S X=$P(IB0,U,4) "RTN","IBCEOB0",190,0) . D FILE^DICN K DIC,DO,DD,DLAYGO "RTN","IBCEOB0",191,0) . I Y<0 K IBDA S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Could not add reason code ("_$P(IB0,U,4)_") for adjustment group code ("_$P(IB0,U,3)_") at line adjustment "_+^TMP($J,40) Q "RTN","IBCEOB0",192,0) . S IBDA=+Y "RTN","IBCEOB0",193,0) ; "RTN","IBCEOB0",194,0) I $G(IBDA) D "RTN","IBCEOB0",195,0) . S LEVEL=15,LEVEL("DIE")="^IBM(361.1,"_IBEOB_",15,"_IBDA(2)_",1,"_IBDA(1)_",1," "RTN","IBCEOB0",196,0) . S LEVEL(0)=IBDA,LEVEL(1)=IBDA(1),LEVEL(2)=IBDA(2),LEVEL(3)=IBEOB "RTN","IBCEOB0",197,0) . S A="5;.02;1;0;0^6;.03;0;1;1^7;.04;0;1;0" "RTN","IBCEOB0",198,0) . S IBOK=$$STORE^IBCEOB1(A,IB0,IBEOB,.LEVEL) "RTN","IBCEOB0",199,0) . I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Mismatched data for reason code ("_$P(IB0,U,4)_"), adjustment group code ("_$P(IB0,U,3)_") at line adjustment "_+^TMP($J,40) Q "RTN","IBCEOB0",200,0) ; "RTN","IBCEOB0",201,0) Q45 Q "RTN","IBCEOB0",202,0) ; "RTN","IBCEOB0",203,0) 46(IB0,IBEOB,IBOK) ; Process record type 46 for EOB "RTN","IBCEOB0",204,0) ; IB0 = the record being processed "RTN","IBCEOB0",205,0) ; IBEOB = the ien of the EOB entry in file 361.1 "RTN","IBCEOB0",206,0) ; IBOK = Returned as 1 if record filed OK, 0 if error occurred "RTN","IBCEOB0",207,0) ; "RTN","IBCEOB0",208,0) S IBOK=0 "RTN","IBCEOB0",209,0) N AGC,IBDA,LEVEL,A,Z0,CT,Z "RTN","IBCEOB0",210,0) I '$G(^TMP($J,40)) D G Q46 "RTN","IBCEOB0",211,0) . S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Service line adjustment (EEOB Record 46) has no matching service line" "RTN","IBCEOB0",212,0) . D DET4X^IBCEOB00(46,IB0,.Z0) "RTN","IBCEOB0",213,0) . ;S CT=+$O(^TMP(IBEGBL,$J,""),-1),Z=0 F S Z=$O(Z0(Z)) Q:'Z S CT=CT+1,^TMP(IBEGBL,$J,CT)=Z0(Z) "RTN","IBCEOB0",214,0) ; "RTN","IBCEOB0",215,0) S AGC=$P(^TMP($J,40),U,2) "RTN","IBCEOB0",216,0) I AGC="" S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Service line adjustment (EEOB Record 46) is missing its group code" G Q46 "RTN","IBCEOB0",217,0) ; "RTN","IBCEOB0",218,0) S IBDA(2)=+^TMP($J,40) "RTN","IBCEOB0",219,0) S IBDA(1)=+$O(^IBM(361.1,IBEOB,15,IBDA(2),1,"B",AGC,0)) "RTN","IBCEOB0",220,0) ; "RTN","IBCEOB0",221,0) ; "RTN","IBCEOB0",222,0) ;Add a new entry at the Payer Policy level "RTN","IBCEOB0",223,0) I $G(IBDA(1)) D "RTN","IBCEOB0",224,0) . S DIC="^IBM(361.1,"_IBEOB_",15,"_IBDA(2)_",1,"_IBDA(1)_",2,",DIC(0)="L",DLAYGO=361.11511,DA(1)=IBDA(1),DA(2)=IBDA(2),DA(3)=IBEOB "RTN","IBCEOB0",225,0) . S DIC("P")=$$GETSPEC^IBEFUNC(361.1151,1) "RTN","IBCEOB0",226,0) . S X=$P(IB0,U,3) "RTN","IBCEOB0",227,0) . D FILE^DICN K DIC,DO,DD,DLAYGO "RTN","IBCEOB0",228,0) . I Y<0 K IBDA S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Could not add payer policy ("_$P(IB0,U,4)_") for adjustment group code ("_$P(IB0,U,3)_") at line adjustment "_+^TMP($J,40) Q "RTN","IBCEOB0",229,0) . S IBDA=+Y,IBOK=1 "RTN","IBCEOB0",230,0) ; "RTN","IBCEOB0",231,0) Q46 Q "RTN","IBCEOB0",232,0) ; "RTN","IBCEOB0",233,0) ; IB*2.0*633 - Begin modified code block "RTN","IBCEOB0",234,0) ERRTXT(X,IBEOB) ; Set error text based on circumstances "RTN","IBCEOB0",235,0) ; Input - X = Standard Error message passed in "RTN","IBCEOB0",236,0) ; IB0 "RTN","IBCEOB0",237,0) ; Returns modified error message text "RTN","IBCEOB0",238,0) N RETURN "RTN","IBCEOB0",239,0) S RETURN="Mismatched "_X_":" "RTN","IBCEOB0",240,0) I '$$EBILL(IBEOB) S RETURN="Claim was not Billed Electronically:" "RTN","IBCEOB0",241,0) Q RETURN "RTN","IBCEOB0",242,0) ; "RTN","IBCEOB0",243,0) EBILL(IBEOB) ; Check If EOB was billed electronically "RTN","IBCEOB0",244,0) ; Input : IBEOB = Internal entry number from file 361.1 "RTN","IBCEOB0",245,0) ; Returns : 1 - Billed electronically "RTN","IBCEOB0",246,0) ; 0 - Not billed electronically "RTN","IBCEOB0",247,0) N IEN399,IEN364,STATUS "RTN","IBCEOB0",248,0) S IEN399=$$GET1^DIQ(361.1,IBEOB_",",.01,"I") "RTN","IBCEOB0",249,0) S IEN364=$O(^IBA(364,"B",+IEN399,0)) "RTN","IBCEOB0",250,0) I 'IEN364 Q 0 ; No EDI TRANSMIT BILL "RTN","IBCEOB0",251,0) ; "RTN","IBCEOB0",252,0) S STATUS=$$GET1^DIQ(364,IEN364,.03,"I") "RTN","IBCEOB0",253,0) I STATUS="E"!(STATUS="C") Q 0 ; Error or canceled "RTN","IBCEOB0",254,0) Q 1 "RTN","IBCEOB0",255,0) ; IB*2.0*633 - End modified code block "RTN","IBJTEP") 0^2^B170521408 "RTN","IBJTEP",1,0) IBJTEP ;ALB/TJB - TP ERA/835 INFORMATION SCREEN ;01-MAY-2015 "RTN","IBJTEP",2,0) ;;2.0;INTEGRATED BILLING;**530,609,633**;21-MAR-94;Build 21 "RTN","IBJTEP",3,0) ;;Per VA Directive 6402, this routine should not be modified. "RTN","IBJTEP",4,0) ;; ; "RTN","IBJTEP",5,0) EN ; -- main entry point for IBJT ERA 835 INFORMATION "RTN","IBJTEP",6,0) D EN^VALM("IBJT ERA 835 INFORMATION") "RTN","IBJTEP",7,0) Q "RTN","IBJTEP",8,0) ; "RTN","IBJTEP",9,0) HDR ; -- header code "RTN","IBJTEP",10,0) N IBRP,IBREJ S IBRP(U)=", " "RTN","IBJTEP",11,0) ; Add the EEOB, Reject and ECME indicators to the Bill "RTN","IBJTEP",12,0) S IBREJ=$S($$BILLREJ^IBJTU6(EPBILL):"c",1:"") "RTN","IBJTEP",13,0) S VALMHDR(1)=$$EEOB^IBJTLA1(IBIFN)_IBREJ_EPBILL_$$ECME^IBTRE(IBIFN)_" "_$E(EPNM,1,20)_" "_EPSS_" DOB: "_EPDOB_" Subsc ID: "_EPSID "RTN","IBJTEP",14,0) S VALMHDR(2)="Svc Date: "_EPDOS_" Orig Amt: "_EPAMT_" ERA#: "_$$REPLACE^XLFSTR(ERALST,.IBRP) "RTN","IBJTEP",15,0) Q "RTN","IBJTEP",16,0) ; "RTN","IBJTEP",17,0) INIT ; -- init variables and list array "RTN","IBJTEP",18,0) N AQ,EPIEN,EPTN,ERADA,ERAIEN,EPARR,EPPCT,EOBCT,EOBLST,EOBMX,FL,IBAR,IBI,IBCOL,IBEBERA,IBRX,IBSHEOB,IBSPEOB ; IB*2.0*633 "RTN","IBJTEP",19,0) N II,LINE,QQ,RCBAMT,RCCOPY,RCRC,RCOIN,RCDED,RCERR,RCFLD,RMIEN,RCRDC,RCRLN,RCXY,RCMD,REMOVED,X,XX,Z "RTN","IBJTEP",20,0) S EOBMX=0 "RTN","IBJTEP",21,0) S ERALST="",$P(SP80," ",80)=" " "RTN","IBJTEP",22,0) ; IBIFN comes in from the TPJI screen and will be cleaned up there "RTN","IBJTEP",23,0) I '$G(IBIFN) S VALMQUIT="" G INITQ "RTN","IBJTEP",24,0) K EPARR D BILL^IBRFN3(IBIFN,.EPARR) ; Get Bill information "RTN","IBJTEP",25,0) S EPBILL=EPARR("BN") ; K-Bill "RTN","IBJTEP",26,0) S EPPAT=$$GET1^DIQ(399,IBIFN_",",.02,"I") ; Get Patient IEN "RTN","IBJTEP",27,0) S EPNM=$$GET1^DIQ(399,IBIFN_",",.02) ; Get Patient Name "RTN","IBJTEP",28,0) ; Get Total Charges and justify the amount "RTN","IBJTEP",29,0) S EPAMT=$J(+EPARR("TCG"),$L(+EPARR("TCG")),2) "RTN","IBJTEP",30,0) S EPSS=$E(EPNM)_$$GET1^DIQ(2,EPPAT_",",.364) ; Get Short SSN "RTN","IBJTEP",31,0) S EPDOB=$$GET1^DIQ(2,EPPAT_",",.03) ; Get DOB "RTN","IBJTEP",32,0) S EPSID=$P(EPARR("PIN"),U,6) ; Get Subscriber ID "RTN","IBJTEP",33,0) S EPDOS=$$FMTE^XLFDT(EPARR("STF"),"5DZ") ; Get Date of Service "RTN","IBJTEP",34,0) S:EPARR("STF")'=EPARR("STT") EPDOS=EPDOS_" - "_$$FMTE^XLFDT(EPARR("STT"),"5DZ") ; If Bill for date range "RTN","IBJTEP",35,0) ; Check to see if we may have an EEOB if not report no ERA Information for this K-Bill "RTN","IBJTEP",36,0) S EPIEN=$O(^IBM(361.1,"B",$G(IBIFN),"")) I EPIEN="" S VALMCNT=2 D SET^VALM10(1," "),SET^VALM10(2,"No ERA Information for Bill: "_EPBILL) G INITQ "RTN","IBJTEP",37,0) ; Get % Collected from AR claim - IA 1452 - IB*2.0*609 "RTN","IBJTEP",38,0) S IBAR=$$BILL^RCJIBFN2(IBIFN),IBCOL=$P(IBAR,U,5) "RTN","IBJTEP",39,0) ; Collect all possible EOBs associated with this Claim "RTN","IBJTEP",40,0) S ERAIEN="" "RTN","IBJTEP",41,0) ; IB*2.0*633 - Start modified block "RTN","IBJTEP",42,0) S IBSHEOB=0,IBI=0,RCCOPY=0 "RTN","IBJTEP",43,0) F S IBI=$O(^IBM(361.1,"B",IBIFN,IBI)) Q:'IBI D ; "RTN","IBJTEP",44,0) . S IBSHEOB=IBSHEOB+1,IBSHEOB(IBI)=0 "RTN","IBJTEP",45,0) . ; For each EOB get the associated ERAs from ADET index "RTN","IBJTEP",46,0) . S ERAIEN="" F S ERAIEN=$O(^RCY(344.4,"ADET",IBI,ERAIEN)) Q:'ERAIEN D ; "RTN","IBJTEP",47,0) . . S IBSHEOB(IBI,ERAIEN)="" "RTN","IBJTEP",48,0) . ; PRCA*4.5*332 - Start modified code block "RTN","IBJTEP",49,0) . I $O(IBSHEOB(IBI,""))="" D ; EOB not assocated with an ERA. Check if it was copied. "RTN","IBJTEP",50,0) . . I $$GET1^DIQ(361.1,IBI_",",.17,"I") Q ; Ignore manually entered EOB "RTN","IBJTEP",51,0) . . S X=$O(^IBM(361.1,IBI,101,"A"),-1) "RTN","IBJTEP",52,0) . . I X,$$GET1^DIQ(361.1101,X_","_IBI_",",.05,"I")="C" D ; EOB is a copy "RTN","IBJTEP",53,0) . . . S RCCOPY=RCCOPY+1 "RTN","IBJTEP",54,0) . . . S RCCOPY(RCCOPY)=IBI "RTN","IBJTEP",55,0) ; IB*2.0*633 - End modified block "RTN","IBJTEP",56,0) ; Loop on the IEN for the EEOBs - exclude MRAs, but include all insurances "RTN","IBJTEP",57,0) S EPIEN="",LINE=0,EOBCT=0 "RTN","IBJTEP",58,0) F S EPIEN=$O(IBSHEOB(EPIEN)) Q:EPIEN="" S ERADA="" F S ERADA=$O(IBSHEOB(EPIEN,ERADA)) Q:'ERADA D ; IB*2.0*633 "RTN","IBJTEP",59,0) . Q:$P($G(^IBM(361.1,EPIEN,0)),U,4)=1 ; Get next because this is an MRA "RTN","IBJTEP",60,0) . S EPTN=$$GET1^DIQ(361.1,EPIEN_",",.07),ERAIEN=ERADA_"," ; IB*2.0*633 "RTN","IBJTEP",61,0) . Q:U_ERALST_U[(U_ERAIEN_U) ; Quit if we have already reported this ERA # "RTN","IBJTEP",62,0) . K IBEPAR,IBPLB "RTN","IBJTEP",63,0) . D GETS^DIQ(344.4,ERAIEN,".01;.02;.03;.04;.05;.06;.07;.08;.09;.1;.11;.12;.13;.14;.15;4.02;","E","IBEPAR") "RTN","IBJTEP",64,0) . D GETS^DIQ(344.4,ERAIEN,"2*;","E","IBPLB") ; ERA Level Adjustments "RTN","IBJTEP",65,0) . Q:$D(IBEPAR)'>0 ; No IBEPAR - no data done with this record. "RTN","IBJTEP",66,0) . S ERALST=$$PUSH(ERALST,ERAIEN) S XLN="ERA#: "_$G(IBEPAR("344.4",ERAIEN,".01","E")),XSP=$E(SP80,1,(22-$L(XLN))) "RTN","IBJTEP",67,0) . S EPPCT=$S($G(EPARR("TCG"))>0:($G(IBEPAR("344.4",ERAIEN,".05","E"))/EPARR("TCG"))*100,1:0) "RTN","IBJTEP",68,0) . D SET(.LINE,"** ERA SUMMARY DATA ** ") "RTN","IBJTEP",69,0) . D SET(.LINE,XLN_XSP_"TRACE#: "_$G(IBEPAR("344.4",ERAIEN,".02","E"))) "RTN","IBJTEP",70,0) . ; Holding onto the line below because the change of calculation "RTN","IBJTEP",71,0) . ; S XLN="ERA DATE (PAYER): "_$G(IBEPAR("344.4",ERAIEN,".04","E"))_" TOTAL AMT PD: "_$J($G(IBEPAR("344.4",ERAIEN,".05","E")),9)_" % COLLECTED: "_$J(EPPCT,6,2) "RTN","IBJTEP",72,0) . S XLN="ERA DATE (PAYER): "_$G(IBEPAR("344.4",ERAIEN,".04","E"))_" TOTAL AMT PD: "_$J($G(IBEPAR("344.4",ERAIEN,".05","E")),9) "RTN","IBJTEP",73,0) . D SET(.LINE,XLN) "RTN","IBJTEP",74,0) . D SET(.LINE,"PAYER NAME/TIN: "_$G(IBEPAR("344.4",ERAIEN,".06","E"))_"/"_$G(IBEPAR("344.4",ERAIEN,".03","E"))) "RTN","IBJTEP",75,0) . D SET(.LINE,"FILE DATE/TIME: "_$G(IBEPAR("344.4",ERAIEN,".07","E"))) "RTN","IBJTEP",76,0) . D SET(.LINE,"EFT MATCH STATUS: "_$G(IBEPAR("344.4",ERAIEN,".09","E"))) "RTN","IBJTEP",77,0) . S XLN="ERA TYPE: "_$G(IBEPAR("344.4",ERAIEN,".1","E")),XSP=$E(SP80,1,(40-$L(XLN))) "RTN","IBJTEP",78,0) . D SET(.LINE,XLN_XSP_"INDIVIDUAL EOB COUNT: "_$G(IBEPAR("344.4",ERAIEN,".11","E"))) "RTN","IBJTEP",79,0) . S XLN="MAIL MESSAGE: "_$G(IBEPAR("344.4",ERAIEN,".12","E")),XSP=$E(SP80,1,(40-$L(XLN))) "RTN","IBJTEP",80,0) . D SET(.LINE,XLN_XSP_"CHECK#: "_$G(IBEPAR("344.4",ERAIEN,".13","E"))) "RTN","IBJTEP",81,0) . S XLN="DETAIL POST STATUS: "_$G(IBEPAR("344.4",ERAIEN,".14","E")),XSP=$E(SP80,1,(40-$L(XLN))) "RTN","IBJTEP",82,0) . D SET(.LINE,XLN_XSP_"EXPECTED PAYMENT METHOD CODE: "_$G(IBEPAR("344.4",ERAIEN,".15","E"))) "RTN","IBJTEP",83,0) . D SET(.LINE," ") "RTN","IBJTEP",84,0) . D SET(.LINE,"********** ERA LEVEL ADJUSTMENTS **********") "RTN","IBJTEP",85,0) . I $D(IBPLB)=0 D SET(.LINE," -- NONE --") "RTN","IBJTEP",86,0) . D:$D(IBPLB)'=0 ; If we have PLB Data report it "RTN","IBJTEP",87,0) .. S FL="",RCF=0 F S FL=$O(IBPLB(344.42,FL)) Q:FL="" D "RTN","IBJTEP",88,0) ... I RCF'=0 D SET(.LINE," ") "RTN","IBJTEP",89,0) ... S RCF=RCF+1 "RTN","IBJTEP",90,0) ... S XLN=" ADJUSTMENT REASON CODE: "_IBPLB(344.42,FL,.02,"E"),XSP=$E(SP80,1,(45-$L(XLN))) "RTN","IBJTEP",91,0) ... I $G(IBPLB(344.42,FL,.02,"E"))'="" S ACT=$$FIND1^DIC(345.1,,"B",IBPLB(344.42,FL,.02,"E")),ACT=$$GET1^DIQ(345.1,ACT,.05) "RTN","IBJTEP",92,0) ... D SET(.LINE,XLN_XSP_"ADJUSTMENT AMOUNT: "_$J(IBPLB(344.42,FL,.03,"E"),9)) "RTN","IBJTEP",93,0) ... D SET(.LINE," ADJUSTMENT CODE TEXT: "_ACT) "RTN","IBJTEP",94,0) ... D SET(.LINE," REFERENCE: "_IBPLB(344.42,FL,.01,"E")) "RTN","IBJTEP",95,0) . D SET(.LINE," ") "RTN","IBJTEP",96,0) . K IBEBERA S ZZEPIEN=EPIEN D EEOB^IBJTEP1("IBEBERA",ERAIEN,EPBILL,1) "RTN","IBJTEP",97,0) . F EOBCT=1:1:IBEBERA D "RTN","IBJTEP",98,0) .. S EPIEN=$O(IBEBERA(EOBCT,"")) "RTN","IBJTEP",99,0) .. I EPIEN,'$D(EOBLST(EPIEN)) D ; "RTN","IBJTEP",100,0) ... D EOBDET(EPIEN,0,EOBCT,IBEBERA,ERAIEN) ; PRCA*4.5*332 "RTN","IBJTEP",101,0) ... S EOBLST(EPIEN)="" "RTN","IBJTEP",102,0) . D SET(.LINE,"================================================================================") "RTN","IBJTEP",103,0) . S EPIEN=ZZEPIEN "RTN","IBJTEP",104,0) I RCCOPY D ; "RTN","IBJTEP",105,0) . S (X,XX)=0 F S X=$O(RCCOPY(X)) Q:'X D ; Display copied EOBs - PRCA*4.5*332 "RTN","IBJTEP",106,0) . . I '$D(EOBLST(RCCOPY(X))) D ; "RTN","IBJTEP",107,0) . . . D EOBDET(RCCOPY(X),1,X,RCCOPY,"") "RTN","IBJTEP",108,0) . . . S EOBLST(RCCOPY(X))="",XX=XX+1 "RTN","IBJTEP",109,0) . I XX D SET(.LINE,"================================================================================") "RTN","IBJTEP",110,0) ; No EEOB IEN, then report that No ERA recieved for this bill "RTN","IBJTEP",111,0) I LINE=0 S VALMCNT=2 D SET^VALM10(1," "),SET^VALM10(2,"No ERA Information for Bill: "_EPBILL) G INITQ "RTN","IBJTEP",112,0) S VALMCNT=LINE "RTN","IBJTEP",113,0) ; "RTN","IBJTEP",114,0) INITQ K IBEPAR,IBPLB,IBEOB,IBDGCR,IBGX,IBSPL,IBEERR,TT,AA,EE,RCPL,ACT,ACNT,CC,XLN,XSP,XSP1,TSDT,TEDT,TRX,TECME,RCF,SP80,X,ZZEPIEN "RTN","IBJTEP",115,0) Q "RTN","IBJTEP",116,0) ; "RTN","IBJTEP",117,0) HELP ; -- help code "RTN","IBJTEP",118,0) S X="?" D DISP^XQORM1 W !! "RTN","IBJTEP",119,0) Q "RTN","IBJTEP",120,0) ; "RTN","IBJTEP",121,0) EXIT ; -- exit code "RTN","IBJTEP",122,0) K EPBILL,EPEOB,ERALST,EPPAT,EPNM,EPSS,EPDOB,EPDOS,EPSID,EPAMT,EPARR "RTN","IBJTEP",123,0) D CLEAR^VALM1,CLEAN^VALM10 "RTN","IBJTEP",124,0) Q "RTN","IBJTEP",125,0) ; "RTN","IBJTEP",126,0) EXPND ; -- expand code "RTN","IBJTEP",127,0) Q "RTN","IBJTEP",128,0) ; "RTN","IBJTEP",129,0) PUSH(VAR,VALUE) ; "RTN","IBJTEP",130,0) S VALUE=$TR(VALUE,",") ; Remove Commas from string "RTN","IBJTEP",131,0) Q:$G(VAR)="" VALUE ; Empty variable "RTN","IBJTEP",132,0) ; If this VALUE is on the list don't add it a second time "RTN","IBJTEP",133,0) I U_VAR_U[(U_VALUE_U) Q VAR "RTN","IBJTEP",134,0) Q VAR_U_VALUE "RTN","IBJTEP",135,0) ; "RTN","IBJTEP",136,0) ; Get the code modifier description "RTN","IBJTEP",137,0) MODC(MCD) ; "RTN","IBJTEP",138,0) Q:$G(MCD)="" "No Modifier Code Description" "RTN","IBJTEP",139,0) N ZZIEN,ZZDEC "RTN","IBJTEP",140,0) S ZZIEN=$$FIND1^DIC(81.3,,"BX","26","","","") "RTN","IBJTEP",141,0) S ZZDEC=$$GET1^DIQ(81.3,ZZIEN_",",.02) "RTN","IBJTEP",142,0) Q:ZZDEC="" "No Modifier Code Description" "RTN","IBJTEP",143,0) Q ZZDEC "RTN","IBJTEP",144,0) ; "RTN","IBJTEP",145,0) SET(LINE,DATA) ; -- set arrays "RTN","IBJTEP",146,0) ; LINE = line number passed by reference "RTN","IBJTEP",147,0) ; DATA = string to add to displayed data "RTN","IBJTEP",148,0) S LINE=LINE+1 "RTN","IBJTEP",149,0) D SET^VALM10(LINE,$G(DATA)) "RTN","IBJTEP",150,0) Q "RTN","IBJTEP",151,0) ; PRCA*4.5*332 - Move EOB display into its own subroutine "RTN","IBJTEP",152,0) EOBDET(EPIEN,TYPE,EOBCT,IBEBERA,ERAIEN) ; Add EOB detail to List Manager Array "RTN","IBJTEP",153,0) ; Input: EPIEN - Internal entry number to file 361.1 "RTN","IBJTEP",154,0) ; TYPE - 0 - EEOB associated with an ERA, 1 - Copied EOB created by split/edit or link payment "RTN","IBJTEP",155,0) ; EOBCT - Count# of this EOB within the ERA "RTN","IBJTEP",156,0) ; IBEBERA - Number of EOBs for this bill in this ERA "RTN","IBJTEP",157,0) ; ERAIEN - Internal entry number from file 344.4 "RTN","IBJTEP",158,0) ; "RTN","IBJTEP",159,0) N IBEOB,IBGX,IBCL,IBDGCR,IBRX,IBSPL,IBEERR,RCTRACE "RTN","IBJTEP",160,0) D GETS^DIQ(361.1,EPIEN_",",".01;.02;.03;.04;.06;.07;.14;1.01;1.02;1.03;1.1;1.11;2.03;2.04;3.03;3.04;3.05;3.06;3.07;102","EI","IBEOB") "RTN","IBJTEP",161,0) D GETS^DIQ(361.1,EPIEN_",","10*;","EI","IBGX"),RESORT^IBJTEP1("IBGX",361.111),RESORT^IBJTEP1("IBGX",361.11) ; Claim Level Adjustments "RTN","IBJTEP",162,0) D GETS^DIQ(361.1,EPIEN_",","15*;","EI","IBCL") ; Line Level Adjustments "RTN","IBJTEP",163,0) D GETS^DIQ(361.1,EPIEN_",","8*;","EI","IBSPL") ; ERA Splits for this EEOB "RTN","IBJTEP",164,0) D GETS^DIQ(361.1,EPIEN_",","20;","","IBEERR") ; EOB Errors if they exist "RTN","IBJTEP",165,0) ; Make it easier to walk the data "RTN","IBJTEP",166,0) D RESORT^IBJTEP1("IBCL",361.11511),RESORT^IBJTEP1("IBCL",361.115),RESORT^IBJTEP1("IBCL",361.1151) "RTN","IBJTEP",167,0) D RESORT^IBJTEP1("IBCL",361.1152),RESORT^IBJTEP1("IBCL",361.1154) "RTN","IBJTEP",168,0) D GETS^DIQ(399,IBEOB(361.1,EPIEN_",",.01,"I")_",","460;","EI","IBDGCR") "RTN","IBJTEP",169,0) S RCTRACE=$G(IBEOB("361.1",EPIEN_",",".07","E")) "RTN","IBJTEP",170,0) I ERAIEN="",RCTRACE'="" S ERAIEN=$O(^RCY(344.4,"D",RCTRACE,"")) "RTN","IBJTEP",171,0) D SET(.LINE,"********** "_$S(TYPE=0:"",1:"COPIED ")_"EOB/835 INFORMATION ("_EOBCT_" of "_IBEBERA_") **********") "RTN","IBJTEP",172,0) I $G(IBEOB("361.1",EPIEN_",","102","I")) D Q ; EOB Removed "RTN","IBJTEP",173,0) . D EOBREM^IBJTEP1(EPIEN,.LINE) "RTN","IBJTEP",174,0) . D SET(.LINE,"--------------------------------------------------------------------------------") "RTN","IBJTEP",175,0) S XLN=" EOB Type: "_$G(IBEOB("361.1",EPIEN_",",".04","E")),XSP=$E(SP80,1,(40-$L(XLN))) "RTN","IBJTEP",176,0) D SET(.LINE,XLN_XSP_"EOB Paid Date: "_$G(IBEOB("361.1",EPIEN_",",".06","E"))) "RTN","IBJTEP",177,0) S TSDT=$$FMTE^XLFDT($G(IBEOB("361.1",EPIEN_",","1.1","I")),"2Z"),TEDT=$$FMTE^XLFDT($G(IBEOB("361.1",EPIEN_",","1.11","I")),"2Z"),XLN=" Svc From Date: "_TSDT,XSP=$E(SP80,1,(40-$L(XLN))) "RTN","IBJTEP",178,0) D SET(.LINE,XLN_XSP_"Svc to Date: "_TEDT) "RTN","IBJTEP",179,0) D SET(.LINE," ICN: "_$G(IBEOB("361.1",EPIEN_",",".14","E"))) "RTN","IBJTEP",180,0) D SET(.LINE," Payer Name/TIN: "_$G(IBEOB("361.1",EPIEN_",",".02","E"))_"/"_$G(IBEOB("361.1",EPIEN_",",".03","E"))) "RTN","IBJTEP",181,0) I ERAIEN D ; "RTN","IBJTEP",182,0) . S XLN=" ERA #: "_$$GET1^DIQ(344.4,ERAIEN_",",".01","E"),XSP=$E(SP80,1,(40-$L(XLN))) "RTN","IBJTEP",183,0) . D SET(.LINE,XLN_XSP_"Auto-Post Status: "_$$GET1^DIQ(344.4,ERAIEN_",","4.02","E")) "RTN","IBJTEP",184,0) . D SET(.LINE," Trace #: "_$$GET1^DIQ(344.4,ERAIEN_",",".02","E")) "RTN","IBJTEP",185,0) E D ; "RTN","IBJTEP",186,0) . D SET(.LINE," Trace #: "_RCTRACE) "RTN","IBJTEP",187,0) S TECME=$P($G(IBDGCR(399,IBEOB(361.1,EPIEN_",",.01,"I")_",",460,"E")),";",1) "RTN","IBJTEP",188,0) D GETRX^IBJTEP1(EPIEN,.IBRX) "RTN","IBJTEP",189,0) S TRX=$$GET1^DIQ(52,+TECME_",",".01")_"/"_$G(IBRX("FILL"))_"/"_$G(IBRX("RELEASED STATUS")) "RTN","IBJTEP",190,0) I TECME="" S TRX="" "RTN","IBJTEP",191,0) S XLN=" ECME #: "_TECME,XSP=$E(SP80,1,(25-$L(XLN))),XSP1=$E(SP80,1,(39-$L(XLN_XSP_"DOS: "_$G(IBRX("DOS"))))) "RTN","IBJTEP",192,0) D SET(.LINE,XLN_XSP_"DOS: "_$G(IBRX("DOS"))_XSP1_"Rx/Fill/Release Status: "_TRX) "RTN","IBJTEP",193,0) D SET(.LINE,"--------------------------------------------------------------------------------") "RTN","IBJTEP",194,0) D:$D(IBSPL)>1 ; This EEOB was split display split payment information "RTN","IBJTEP",195,0) . N SPL "RTN","IBJTEP",196,0) . D SET(.LINE,"** A/R CORRECTED PAYMENT DATA:") "RTN","IBJTEP",197,0) . D SET(.LINE," TOTAL AMT PD: "_$J(IBEOB(361.1,EPIEN_",",1.01,"E"),9,2)) "RTN","IBJTEP",198,0) . S SPL="" F S SPL=$O(IBSPL(361.18,SPL)) Q:SPL="" D "RTN","IBJTEP",199,0) .. D SET(.LINE," "_$S(IBSPL(361.18,SPL,.03,"I")'="":$$BN1^PRCAFN(IBSPL(361.18,SPL,.03,"I"))_$J("",8),1:"[suspense] "_IBSPL(361.18,SPL,.01,"E"))_" "_$J(IBSPL(361.18,SPL,.02,"E"),9,2)) "RTN","IBJTEP",200,0) . D SET(.LINE," ") "RTN","IBJTEP",201,0) D SET(.LINE,"CLAIM LEVEL PAY STATUS:") "RTN","IBJTEP",202,0) D SET(.LINE," Total Submitted Charges :"_$J($G(IBEOB("361.1",EPIEN_",","2.04","E")),11,2)_" Payer Covered Amount :"_$J($G(IBEOB("361.1",EPIEN_",","1.03","E")),11,2)) "RTN","IBJTEP",203,0) D SET(.LINE," Payer Paid Amount :"_$J($G(IBEOB("361.1",EPIEN_",","1.01","E")),11,2)_" MEDICARE Allowed Amount :"_$J($G(IBEOB("361.1",EPIEN_",","2.03","E")),11,2)) "RTN","IBJTEP",204,0) D SET(.LINE," Patient Responsibility :"_$J($G(IBEOB("361.1",EPIEN_",","1.02","E")),11,2)_" % Collected :"_$J(+IBCOL,11,0)_" %") ; IB*2.0*609 "RTN","IBJTEP",205,0) D SET(.LINE,"--------------------------------------------------------------------------------") "RTN","IBJTEP",206,0) D SET(.LINE,"CLAIM LEVEL ADJUSTMENTS:") "RTN","IBJTEP",207,0) S AA="",ACNT=0 F S AA=$O(IBGX(361.11,AA)) Q:AA="" S ACNT=ACNT+1,AQ="" D "RTN","IBJTEP",208,0) . S CC=AA F S CC=$O(IBGX(361.111,CC)) Q:$E(CC,1,$L(AA))'=AA D "RTN","IBJTEP",209,0) .. I AQ="" S AQ=$J(ACNT,3)_") " "RTN","IBJTEP",210,0) .. E S ACNT=ACNT+1,AQ=$J(ACNT,3)_") " "RTN","IBJTEP",211,0) .. D SET(.LINE,AQ_"ADJ. AMT: "_$J(IBGX(361.111,CC,.02,"E"),9,2)_" ADJ GROUP: "_IBGX(361.11,AA,.01,"I")_" => "_IBGX(361.11,AA,.01,"E")) "RTN","IBJTEP",212,0) .. S RMIEN=$$FIND1^DIC(345,"","BX",IBGX(361.111,CC,.01,"E"),"","","RCERR") "RTN","IBJTEP",213,0) .. I RMIEN'="" K RCERR,RCRDC,RCFLD S RCXY=$$GET1^DIQ(345,RMIEN_",",4,"","RCRDC","RCERR") D DLN^IBJTEP1("RCRDC","RCFLD",55,69) "RTN","IBJTEP",214,0) .. D SET(.LINE," ADJ. CODE: "_IBGX(361.111,CC,.01,"E")_" => "_RCFLD(1)) "RTN","IBJTEP",215,0) .. I RCFLD>1 F II=2:1:RCFLD D SET(.LINE," "_RCFLD(II)) "RTN","IBJTEP",216,0) I ACNT=0 D SET(.LINE," -- None --") "RTN","IBJTEP",217,0) D SET(.LINE,"CLAIM LEVEL REMARKS: ") "RTN","IBJTEP",218,0) S RCRC=0 F II="3.03","3.04","3.05","3.06","3.07" D:IBEOB("361.1",EPIEN_",",II,"E")'="" "RTN","IBJTEP",219,0) . ; Get IEN for this remark code - if no IEN then need to look at the data "RM1" to "RM5" "RTN","IBJTEP",220,0) . S RMIEN=$$FIND1^DIC(346,"","BX",IBEOB("361.1",EPIEN_",",II,"E"),"","","RCERR") "RTN","IBJTEP",221,0) . I RMIEN'="" K RCERR,RCRDC,RCFLD S RCXY=$$GET1^DIQ(346,RMIEN_",",4,"","RCRDC","RCERR") D DLN^IBJTEP1("RCRDC","RCFLD",57,69) "RTN","IBJTEP",222,0) . I RMIEN="" S RCFLD=$S(II="3.03":5.011,II="3.04":5.021,II="3.05":5.031,II="3.06":5.041,II="3.07":5.051,1:5.011) S RCRLN=$$GET1^DIQ(361.1,EPIEN_",",RCFLD) "RTN","IBJTEP",223,0) . S RCRC=RCRC+1 D SET(.LINE," --- REMARK CODE("_RCRC_"): "_IBEOB("361.1",EPIEN_",",II,"E")_" => "_RCFLD(1)) "RTN","IBJTEP",224,0) . I RCFLD>1 F II=2:1:RCFLD D SET(.LINE," "_RCFLD(II)) "RTN","IBJTEP",225,0) I RCRC=0 D SET(.LINE," -- None --") "RTN","IBJTEP",226,0) D SET(.LINE,"--------------------------------------------------------------------------------") "RTN","IBJTEP",227,0) ; Walk through the line level information... "RTN","IBJTEP",228,0) D SET(.LINE,"EEOB LINE LEVEL ADJUSTMENTS:") "RTN","IBJTEP",229,0) K ^XTMP("IBJTEP",$J) M ^XTMP("IBJTEP",$J)=IBCL "RTN","IBJTEP",230,0) S RCPL=0,EE="" F S EE=$O(IBCL(361.115,EE)) Q:EE="" S RCPL=RCPL+1 D "RTN","IBJTEP",231,0) . S QQ=EE,RCMD="" F S QQ=$O(IBCL(361.1152,QQ)) Q:$E(QQ,1,$L(EE))'=EE S RCMD=IBCL(361.1152,QQ,.01,"I") "RTN","IBJTEP",232,0) . D SET(.LINE," # SV DT REVCD PROC MOD UNITS BILLED DEDUCT COINS ALLOW PYMT") "RTN","IBJTEP",233,0) . S RCBAMT=$$BILLN^IBJTEP1(IBEOB(361.1,EPIEN_",",.01,"I"),IBCL(361.115,EE,.1,"E"),IBCL(361.115,EE,.04,"E")) "RTN","IBJTEP",234,0) . S RCDED=$$ADJU^IBJTEP1("DEDUCT",.IBCL,EE),RCOIN=$$ADJU^IBJTEP1("COINS",.IBCL,EE) ; Get Deductable and Co-Insurance amts. "RTN","IBJTEP",235,0) . S XLN=$J(RCPL,2,0)_" "_$$FMTE^XLFDT(IBCL(361.115,EE,.16,"I"),"2Z")_" "_$$CJ^XLFSTR(IBCL(361.115,EE,.1,"E"),5)_" "_$$CJ^XLFSTR(IBCL(361.115,EE,.04,"E"),8)_$$CJ^XLFSTR(RCMD,5)_" "_$$CJ^XLFSTR(IBCL(361.115,EE,.11,"E"),3) "RTN","IBJTEP",236,0) . D SET(.LINE,XLN_" "_$J(RCBAMT,9,2)_$J(RCDED,8,2)_$J(RCOIN,8,2)_$J(IBCL(361.115,EE,.13,"E"),9,2)_$J(IBCL(361.115,EE,.03,"E"),9,2)) "RTN","IBJTEP",237,0) . D SET(.LINE," ") "RTN","IBJTEP",238,0) . D SET(.LINE," Product/Service Description:"_IBCL(361.115,EE,.09,"E")) "RTN","IBJTEP",239,0) . D SET(.LINE," Payer Policy Reference:"_$G(IBCL(361.11512,EE,.01,"E"))) "RTN","IBJTEP",240,0) . D SET(.LINE," ") "RTN","IBJTEP",241,0) . S ACNT=0,AA=EE F S AA=$O(IBCL(361.1151,AA)) Q:$E(AA,1,$L(EE))'=EE D "RTN","IBJTEP",242,0) .. S ACNT=ACNT+1 "RTN","IBJTEP",243,0) .. S CC=AA,RCRC=0 F S CC=$O(IBCL(361.11511,CC)) Q:$E(CC,1,$L(AA))'=AA D "RTN","IBJTEP",244,0) ... S RCRC=RCRC+1 D SET(.LINE," -> ADJ AMT: "_$J(IBCL(361.11511,CC,.02,"E"),9,2)_" ADJ GROUP: "_IBCL(361.1151,AA,.01,"I")_" - "_IBCL(361.1151,AA,.01,"E")_" "_$$CJ^XLFSTR("QTY: "_+$G(IBCL(361.11511,CC,.03,"E")),8)) "RTN","IBJTEP",245,0) ... S RCXY=$$FIND1^DIC(345,"","BX",IBCL(361.11511,CC,.01,"E"),"","","RCERR") "RTN","IBJTEP",246,0) ... K RCRDC,RCERR S RCXY=$$GET1^DIQ(345,RCXY_",",4,"","RCRDC","RCERR") "RTN","IBJTEP",247,0) ... I $D(RCRDC)>0 K RCFLD D DLN^IBJTEP1("RCRDC","RCFLD",57,57) "RTN","IBJTEP",248,0) ... I $D(RCRDC)=0 K RCFLD S RCRDC(1)=IBCL(361.11511,CC,.04,"E") D DLN^IBJTEP1("RCRDC","RCFLD",57,57) ; If no data from file 345 use data from FMS "RTN","IBJTEP",249,0) ... D SET(.LINE," ADJ CODE: "_$$CJ^XLFSTR(IBCL(361.11511,CC,.01,"E"),5)_" "_RCFLD(1)) "RTN","IBJTEP",250,0) ... I RCFLD>1 F II=2:1:RCFLD D SET(.LINE," "_RCFLD(II)) "RTN","IBJTEP",251,0) . ; Display RARC Codes for this Line Item "RTN","IBJTEP",252,0) . I $D(IBCL(361.1154))'=0 S QQ=EE,RCMD="" F S QQ=$O(IBCL(361.1154,QQ)) Q:$E(QQ,1,$L(EE))'=EE D "RTN","IBJTEP",253,0) .. S RMIEN=$$FIND1^DIC(346,"","BX",IBCL(361.1154,QQ,.02,"E"),"","","RCERR") "RTN","IBJTEP",254,0) .. I RMIEN'="" K RCERR,RCRDC,RCFLD S RCXY=$$GET1^DIQ(346,RMIEN_",",4,"","RCRDC","RCERR") D DLN^IBJTEP1("RCRDC","RCFLD",57,68) "RTN","IBJTEP",255,0) .. D SET(.LINE," --- RARC: "_IBCL(361.1154,QQ,.02,"E")_" - "_RCFLD(1)) "RTN","IBJTEP",256,0) .. I RCFLD>1 F II=2:1:RCFLD D SET(.LINE," "_RCFLD(II)) "RTN","IBJTEP",257,0) . D SET(.LINE," ") "RTN","IBJTEP",258,0) I ACNT=0 D SET(.LINE," -- No Line Level Adjustments --") "RTN","IBJTEP",259,0) ; If there are EOB Errors add them to the screen "RTN","IBJTEP",260,0) D:$D(IBEERR(361.1,EPIEN_",",20))>9 "RTN","IBJTEP",261,0) . D SET(.LINE," "),SET(.LINE,"EEOB MESSAGE ERRORS:") "RTN","IBJTEP",262,0) . N II S II=0 F S II=$O(IBEERR(361.1,EPIEN_",",20,II)) Q:(II="")!(II'=+II) D SET(.LINE,$G(IBEERR(361.1,EPIEN_",",20,II))) "RTN","IBJTEP",263,0) Q "RTN","IBJTEP1") 0^3^B58092745 "RTN","IBJTEP1",1,0) IBJTEP1 ;ALB/TJB - TP ERA/835 INFORMATION SCREEN ;01-MAY-2015 "RTN","IBJTEP1",2,0) ;;2.0;INTEGRATED BILLING;**530,633**;21-MAR-94;Build 21 "RTN","IBJTEP1",3,0) ;;Per VA Directive 6402, this routine should not be modified. "RTN","IBJTEP1",4,0) ;; ; "RTN","IBJTEP1",5,0) Q "RTN","IBJTEP1",6,0) ; Utility Routine for the IBJTEP & IBJTPE routines "RTN","IBJTEP1",7,0) EEOB(ARRAY,IENERA,KBILL,SPLIT) ; Return all of the EEOBs with this KBILL for the ERA IEN in 344.4 "RTN","IBJTEP1",8,0) N ZZ,IBZZ,CNT,IBI,IBDG,AA "RTN","IBJTEP1",9,0) S CNT=0 "RTN","IBJTEP1",10,0) D GETS^DIQ(344.4,IENERA_",","1*;","IE","IBZZ") "RTN","IBJTEP1",11,0) S ZZ="" F S ZZ=$O(IBZZ(344.41,ZZ)) Q:ZZ="" D:IBZZ(344.41,ZZ,.02,"E")=KBILL "RTN","IBJTEP1",12,0) . Q:$P($G(^IBM(361.1,IBZZ(344.41,ZZ,.02,"I"),0)),U,4)=1 ; Don't count, it is a MRA "RTN","IBJTEP1",13,0) . S CNT=CNT+1,@ARRAY@(CNT,IBZZ(344.41,ZZ,.02,"I"))=1,AA(IBZZ(344.41,ZZ,.02,"I"))=1 "RTN","IBJTEP1",14,0) . ; See if any splits are associated with this KBILL "RTN","IBJTEP1",15,0) . D:+$G(SPLIT)'=0 "RTN","IBJTEP1",16,0) .. S IBI=0,IBDG=$$FIND1^DIC(399,,,IBZZ(344.41,ZZ,.02,"E"),"B",) "RTN","IBJTEP1",17,0) .. I IBDG'="" F S IBI=$O(^IBM(361.1,"C",IBDG,IBI)) Q:'IBI S:$G(AA(IBI))'=1 CNT=CNT+1,@ARRAY@(CNT,IBI)=1 ; EOB has been reapportioned at the site "RTN","IBJTEP1",18,0) S @ARRAY=CNT "RTN","IBJTEP1",19,0) Q "RTN","IBJTEP1",20,0) ; "RTN","IBJTEP1",21,0) ; IEN = IEN for File 399, CODE = Revenue Code, CPT = the procedure code for this line "RTN","IBJTEP1",22,0) ; Return the billed amount for this line "RTN","IBJTEP1",23,0) BILLN(IEN,CODE,CPT) ; Get the line item information from the Bill "RTN","IBJTEP1",24,0) N RCOUT,II,RET "RTN","IBJTEP1",25,0) S RET=0 "RTN","IBJTEP1",26,0) K RCOUT D FIND^DIC(399.042,","_IEN_",",".01;.02;.03;.04;.06","",CODE,"","","","","RCOUT") "RTN","IBJTEP1",27,0) S II="" F S II=$O(RCOUT("DILIST","ID",II)) Q:II="" I RCOUT("DILIST","ID",II,.06)=CPT S RET=RCOUT("DILIST","ID",II,.04) Q "RTN","IBJTEP1",28,0) Q RET "RTN","IBJTEP1",29,0) ; "RTN","IBJTEP1",30,0) ADJU(TYPE,ARR1,END) ; Get the Deduction information from the line level "RTN","IBJTEP1",31,0) ; TYPE = "DEDUCT" or "COINS", pass array by reference, END - quit condition "RTN","IBJTEP1",32,0) N RCOUT,AA,BB,RET "RTN","IBJTEP1",33,0) S RET=0 "RTN","IBJTEP1",34,0) S AA=END F S AA=$O(ARR1(361.1151,AA)) Q:$E(AA,1,$L(END))'=END D:ARR1(361.1151,AA,.01,"I")="PR" "RTN","IBJTEP1",35,0) . S BB=AA F S BB=$O(ARR1(361.11511,BB)) Q:$E(BB,1,$L(AA))'=AA D Q:RET'=0 "RTN","IBJTEP1",36,0) .. I TYPE="DEDUCT" S:ARR1(361.11511,BB,.01,"E")=1 RET=ARR1(361.11511,BB,.02,"E") ; Deductable "RTN","IBJTEP1",37,0) .. I TYPE="COINS" S:ARR1(361.11511,BB,.01,"E")=2 RET=ARR1(361.11511,BB,.02,"E") ; Co-Insurance "RTN","IBJTEP1",38,0) Q RET "RTN","IBJTEP1",39,0) ; "RTN","IBJTEP1",40,0) RESORT(ZAR,ZIDX) ; Resort the subscripts from GETS so items collate correctly while walking the array "RTN","IBJTEP1",41,0) ; Pass ZAR through indirection "RTN","IBJTEP1",42,0) ; Take the second subscript and reverse the pieces, put them in right order "RTN","IBJTEP1",43,0) Q:$G(ZIDX)']"" "RTN","IBJTEP1",44,0) N II,XX,YY,ZZ,Z1,ZN,A S ZZ="",ZN="" "RTN","IBJTEP1",45,0) F S ZZ=$O(@ZAR@(ZIDX,ZZ)) Q:ZZ="" D "RTN","IBJTEP1",46,0) . S ZN="" F II=1:1:($L(ZZ,",")-1) S ZN=$P(ZZ,",",II)_","_ZN "RTN","IBJTEP1",47,0) . S XX="" F S XX=$O(@ZAR@(ZIDX,ZZ,XX)) Q:XX="" D "RTN","IBJTEP1",48,0) .. I $D(@ZAR@(ZIDX,ZZ,XX,"E"))=1 S YY=@ZAR@(ZIDX,ZZ,XX,"E") K @ZAR@(ZIDX,ZZ,XX,"E") S QQ(ZN,XX,"E")=YY "RTN","IBJTEP1",49,0) .. I $D(@ZAR@(ZIDX,ZZ,XX,"I"))=1 S YY=@ZAR@(ZIDX,ZZ,XX,"I") K @ZAR@(ZIDX,ZZ,XX,"I") S QQ(ZN,XX,"I")=YY "RTN","IBJTEP1",50,0) M @ZAR@(ZIDX)=QQ "RTN","IBJTEP1",51,0) K QQ "RTN","IBJTEP1",52,0) Q "RTN","IBJTEP1",53,0) ; "RTN","IBJTEP1",54,0) RECEIPT ; Go to Receipt profile "RTN","IBJTEP1",55,0) ; Build the ^TMP(RCDPDPLM,$J,"IDX",#,#)=# array if we have a receipt on this ERA "RTN","IBJTEP1",56,0) ; ERALST, IBIFN is passed in by IBJTEP and will be cleaned up there "RTN","IBJTEP1",57,0) N IBERA,IBEPB,IBRP,DIR,DTOUT,DUOUT,DZX,EPIEN,I,IX,INDEX,X,Y,IBARR,IBAR2,IBAR3,RCDEPTDA,RCRECTDA,RCDPFXIT "RTN","IBJTEP1",58,0) D FULL^VALM1 "RTN","IBJTEP1",59,0) S VALMBCK="R" "RTN","IBJTEP1",60,0) RC1 ; "RTN","IBJTEP1",61,0) S IBRP(U)=", " "RTN","IBJTEP1",62,0) I $L(ERALST,U)=1 S IBERA=ERALST G RC2 "RTN","IBJTEP1",63,0) S DIR("A")="Enter ERA for receipt review: ",DIR(0)="FA^1:10" "RTN","IBJTEP1",64,0) S DIR("A",1)="Enter an ERA# from the following list for additional information." "RTN","IBJTEP1",65,0) S DIR("A",2)="Available ERAs: "_$$REPLACE^XLFSTR(ERALST,.IBRP) "RTN","IBJTEP1",66,0) D ^DIR K DIR "RTN","IBJTEP1",67,0) I $D(DTOUT)!$D(DUOUT)!(Y="") G RCQ "RTN","IBJTEP1",68,0) S IBERA=Y I (U_ERALST_U)'[(U_Y_U) W !!,"ERA: "_Y_" not a valid selection. Please try again...",! S X="",IBERA="" G RC1 "RTN","IBJTEP1",69,0) ; "RTN","IBJTEP1",70,0) RC2 ; "RTN","IBJTEP1",71,0) I $G(IBERA)="" S DIR("A",1)="No ERAs for this K-Bill exist.",DIR(0)="EA",DIR("A")="Press ENTER to continue: " W ! D ^DIR K DIR G RCQ "RTN","IBJTEP1",72,0) ; Get zero node of ERA "RTN","IBJTEP1",73,0) S ZN=$G(^RCY(344.4,IBERA,0)) "RTN","IBJTEP1",74,0) ; Get Reciept for this Bill "RTN","IBJTEP1",75,0) K IBEPB,^TMP("RCDPDPLM",$J) D GETS^DIQ(344.4,IBERA_",","1*;","IE","IBEPB") "RTN","IBJTEP1",76,0) ; No Receipt then report and quit "RTN","IBJTEP1",77,0) I $P(ZN,U,8)="",$D(^RCY(344.4,IBERA,1,"RECEIPT"))=0 S DIR("A",1)="No receipts exist for this ERA.",DIR(0)="EA",DIR("A")="Press ENTER to continue: " W ! D ^DIR K DIR G RCQ "RTN","IBJTEP1",78,0) ; Reciept, build temp global and call RECEIPTS "RTN","IBJTEP1",79,0) S I=0,IX="" F S IX=$O(IBEPB(344.41,IX)) Q:IX="" I $G(IBEPB(344.41,IX,.02,"E"))=EPBILL D "RTN","IBJTEP1",80,0) . ; Add Reciept to list if not already on this list "RTN","IBJTEP1",81,0) . I $G(IBEPB(344.41,IX,.25,"I"))'="" S:'$D(^TMP("RCDPDPLM",$J,"RCPT",IBEPB(344.41,IX,.25,"I"))) I=I+1,^TMP("RCDPDPLM",$J,"IDX",I,I)=$G(IBEPB(344.41,IX,.25,"I")),^TMP("RCDPDPLM",$J,"RCPT",IBEPB(344.41,IX,.25,"I"))="" "RTN","IBJTEP1",82,0) ; if no receipts, then set the single Receipt from the zero node. "RTN","IBJTEP1",83,0) I '$D(^TMP("RCDPDPLM",$J,"IDX")) S:$P(ZN,U,8)'="" ^TMP("RCDPDPLM",$J,"IDX",1,1)=$P(ZN,U,8),^TMP("RCDPDPLM",$J,"RCPT",$P(ZN,U,8))="" I $P(ZN,U,8)="" D G RCQ "RTN","IBJTEP1",84,0) . S DIR("A",1)="Issue with ERA: "_IBERA_" and Bill No.: "_EPBILL,DIR(0)="EA",DIR("A")="Press ENTER to continue: " W ! D ^DIR K DIR "RTN","IBJTEP1",85,0) ; "RTN","IBJTEP1",86,0) S RCRECTDA=$$GETRCPT($NA(^TMP("RCDPDPLM",$J,"IDX"))) "RTN","IBJTEP1",87,0) I RCRECTDA=-1 G RCQ ; no selection, "^" or read timeout "RTN","IBJTEP1",88,0) D EN^VALM("RCDP RECEIPT PROFILE") "RTN","IBJTEP1",89,0) ; "RTN","IBJTEP1",90,0) RCQ ; "RTN","IBJTEP1",91,0) ; If RCDPFXIT is set, exit option entirely was selected so quit back to the menu "RTN","IBJTEP1",92,0) I $G(RCDPFXIT) S VALMBCK="Q" "RTN","IBJTEP1",93,0) K ^TMP("RCDPDPLM",$J) "RTN","IBJTEP1",94,0) Q "RTN","IBJTEP1",95,0) ; "RTN","IBJTEP1",96,0) GETRCPT(ARRAY) ; If only one receipt return with the single receipt, otherwise user selects receipt "RTN","IBJTEP1",97,0) I '$O(@ARRAY@(1)) Q $S($G(@ARRAY@(1,1))'="":$G(@ARRAY@(1,1)),1:-1) "RTN","IBJTEP1",98,0) N ZX,ZY,ZZ,ZAR,DIR,X,Y,DTOUT,DUOUT,DIROUT,DIRUT,QQ "RTN","IBJTEP1",99,0) S ZZ=0,QQ="",ZX="" F S ZX=$O(@ARRAY@(ZX)) Q:ZX="" S:QQ'="" QQ=QQ_";" S ZZ=ZZ+1,QQ=QQ_ZZ_":"_$P($G(^RCY(344,@ARRAY@(ZX,ZX),0)),U,1),ZAR(ZZ)=@ARRAY@(ZX,ZX) "RTN","IBJTEP1",100,0) S DIR(0)="S^"_QQ "RTN","IBJTEP1",101,0) S DIR("A")="Enter index number for Receipt" D ^DIR K DIR "RTN","IBJTEP1",102,0) I $D(DTOUT)!$D(DUOUT)!(Y="") Q -1 ; no selection/timeout quit "RTN","IBJTEP1",103,0) Q ZAR(Y) "RTN","IBJTEP1",104,0) ; "RTN","IBJTEP1",105,0) GETRX(IBIEN,IBARRY) ;return pharmacy data to about EEOB items "RTN","IBJTEP1",106,0) ; input - IBIEN = ien to record in 361.1 "RTN","IBJTEP1",107,0) ; IBARRY = Array name that will be used to store and return pharmacy data elements "RTN","IBJTEP1",108,0) ; output - IBARRY = holds pharmacy data "RTN","IBJTEP1",109,0) ; IA 6033 (controlled subscription) - read access of file 362.4. status is pending "RTN","IBJTEP1",110,0) ; ICR 1878 (supported) - usage of EN^PSOORDER "RTN","IBJTEP1",111,0) ; "RTN","IBJTEP1",112,0) N IB0,RXDATA,RXIEN,IBDFN,PRIEN,RXFILL "RTN","IBJTEP1",113,0) K IBARRY "RTN","IBJTEP1",114,0) Q:IBIEN="" "RTN","IBJTEP1",115,0) S PRIEN=$P(^IBM(361.1,IBIEN,0),U,1) Q:PRIEN="" "RTN","IBJTEP1",116,0) S IBDFN=$P(^PRCA(430,PRIEN,0),U,7) "RTN","IBJTEP1",117,0) S IB0=+$O(^IBA(362.4,"C",PRIEN,0)) "RTN","IBJTEP1",118,0) Q:IB0=0 "RTN","IBJTEP1",119,0) S RXDATA=$G(^IBA(362.4,IB0,0)) "RTN","IBJTEP1",120,0) S IBARRY("DOS")=$$FMTE^XLFDT($P(RXDATA,U,3),"2Z") "RTN","IBJTEP1",121,0) S IBARRY("FILL")=+$P(RXDATA,U,10) ; rx fill# "RTN","IBJTEP1",122,0) S RXIEN=+$P(RXDATA,U,5) ; RX ien ptr file 52 "RTN","IBJTEP1",123,0) D EN^PSOORDER(IBDFN,RXIEN) "RTN","IBJTEP1",124,0) S IBARRY("RX")=$P(^TMP("PSOR",$J,RXIEN,0),U,5) "RTN","IBJTEP1",125,0) I IBARRY("FILL")=0 S IBARRY("RELEASED STATUS")=$S($P(^TMP("PSOR",$J,RXIEN,0),U,13)]"":"Released",1:"Not Released") ; Release status from Rx on the first fill (no refills) "RTN","IBJTEP1",126,0) I IBARRY("FILL")>0 S IBARRY("RELEASED STATUS")=$S($P(^TMP("PSOR",$J,RXIEN,"REF",IBARRY("FILL"),0),U,8)]"":"Released",1:"Not Released") ; Release status from Rx refill # "RTN","IBJTEP1",127,0) Q "RTN","IBJTEP1",128,0) ; "RTN","IBJTEP1",129,0) EOBREM(RCEOB,LINE) ; EP from IBJTEP - Show EOB removal details if EOB removed "RTN","IBJTEP1",130,0) ; Input: RCEOB - Internal entry number from file 361.1 "RTN","IBJTEP1",131,0) ; LINE - Line counter for ListMan storage "RTN","IBJTEP1",132,0) ; Output: To screen "RTN","IBJTEP1",133,0) ; Get last move/copy history record "RTN","IBJTEP1",134,0) N I,J,RCEOBH,RCJUST "RTN","IBJTEP1",135,0) S RCEOBH=$O(^IBM(361.1,RCEOB,101,"A"),-1) "RTN","IBJTEP1",136,0) ; Quit if EOB if no history found - should not occur since EOB is removed "RTN","IBJTEP1",137,0) I 'RCEOBH D SET^IBJTEP(.LINE,"**EOB Removed**") Q "RTN","IBJTEP1",138,0) ; "RTN","IBJTEP1",139,0) D SET^IBJTEP(.LINE,"EOB Removed by : "_$$GET1^DIQ(361.1101,RCEOBH_","_RCEOB,.02,"E")) "RTN","IBJTEP1",140,0) D SET^IBJTEP(.LINE,"Date/Time Removed : "_$$GET1^DIQ(361.1101,RCEOBH_","_RCEOB,.01,"E")) "RTN","IBJTEP1",141,0) S RCJUST=$$GET1^DIQ(361.1101,RCEOBH_","_RCEOB,.03,"E") "RTN","IBJTEP1",142,0) I $L(RCJUST>59) D ; "RTN","IBJTEP1",143,0) . S I=1 "RTN","IBJTEP1",144,0) . F J=1:1:$L(RCJUST," ") D ; "RTN","IBJTEP1",145,0) . . I $L($G(RCJUST(I))_$P(RCJUST," ",J))>60 S I=I+1 "RTN","IBJTEP1",146,0) . . S RCJUST(I)=$G(RCJUST(I))_" "_$P(RCJUST," ",J) "RTN","IBJTEP1",147,0) E S RCJUST(1)=RCJUST "RTN","IBJTEP1",148,0) D SET^IBJTEP(.LINE,"Justification :"_$G(RCJUST(1))) "RTN","IBJTEP1",149,0) F J=2:1:I D SET^IBJTEP(.LINE," "_$G(RCJUST(J))) "RTN","IBJTEP1",150,0) Q "RTN","IBJTEP1",151,0) ; "RTN","IBJTEP1",152,0) ; Make CARC or RARC description lines the right length for display - IB*2.0*633 Moved for routine size "RTN","IBJTEP1",153,0) DLN(ZIN,ZARR,FLN,SLN) ; "RTN","IBJTEP1",154,0) ; ZIN - array to get lines of text "RTN","IBJTEP1",155,0) ; ZRARR - array for display passed by indirection "RTN","IBJTEP1",156,0) ; FLN - First line length; SLN - Second and subsequent line lengths "RTN","IBJTEP1",157,0) N ZI,ZX,ZL,ZXL,ZICT,ZCT,ZSP,ZLN "RTN","IBJTEP1",158,0) S ZI="",ZCT=0,ZICT=0 "RTN","IBJTEP1",159,0) ; Get number of lines in array "RTN","IBJTEP1",160,0) F S ZI=$O(@ZIN@(ZI)) Q:ZI="" S ZICT=ZICT+1 "RTN","IBJTEP1",161,0) ; If more than one line in array, process the line "RTN","IBJTEP1",162,0) D:ZICT>1 "RTN","IBJTEP1",163,0) . S ZI="",ZL="" F S ZI=$O(@ZIN@(ZI)) Q:ZI="" S ZL=ZL_$S($L(ZL)>1:" ",1:"")_@ZIN@(ZI) D "RTN","IBJTEP1",164,0) .. F Q:$L(ZL)FLN ; First line "RTN","IBJTEP1",166,0) .... S ZXL="" F ZX=1:1 Q:($L(ZXL)+$L($P(ZL," ",ZX)))>FLN S ZXL=ZXL_$S($L(ZXL)>0:" ",1:"")_$P(ZL," ",ZX) "RTN","IBJTEP1",167,0) .... K ZSP S @ZARR@(ZCT)=ZXL,ZSP(ZXL)="",ZL=$$REPLACE^XLFSTR(ZL,.ZSP),ZL=$$TRIM^XLFSTR(ZL) "RTN","IBJTEP1",168,0) ... D:ZCT>1 "RTN","IBJTEP1",169,0) .... S ZXL="" F ZX=1:1 Q:($L(ZXL)+$L($P(ZL," ",ZX)))>SLN S ZXL=ZXL_$S($L(ZXL)>0:" ",1:"")_$P(ZL," ",ZX) "RTN","IBJTEP1",170,0) .... K ZSP S @ZARR@(ZCT)=ZXL,ZSP(ZXL)="",ZL=$$REPLACE^XLFSTR(ZL,.ZSP),ZL=$$TRIM^XLFSTR(ZL) "RTN","IBJTEP1",171,0) . I ($L(ZL)>1) S ZCT=ZCT+1,@ZARR@(ZCT)=ZL,ZL="" "RTN","IBJTEP1",172,0) . S @ZARR=ZCT "RTN","IBJTEP1",173,0) ; One line in array break up if necessary "RTN","IBJTEP1",174,0) I ZICT=1 D "RTN","IBJTEP1",175,0) . S ZX=$O(@ZIN@("")) "RTN","IBJTEP1",176,0) . I $L(@ZIN@(ZX))FLN S ZL=ZL_$S($L(ZL)>0:" ",1:"")_$P(@ZIN@(ZX)," ",ZI) "RTN","IBJTEP1",179,0) . S @ZARR@(1)=ZL,@ZARR@(2)=$P(@ZIN@(ZX)," ",ZI,9999) "RTN","IBJTEP1",180,0) . S @ZARR=2 "RTN","IBJTEP1",181,0) Q "RTN","IBJTPE") 0^4^B134610496 "RTN","IBJTPE",1,0) IBJTPE ;ALB/TJB - TP ERA/835 PRINT EEOB INFORMATIN SCREEN ;20-MAY-2015 "RTN","IBJTPE",2,0) ;;2.0;INTEGRATED BILLING;**530,609,633**;21-MAR-94;Build 21 "RTN","IBJTPE",3,0) ;;Per VA Directive 6402, this routine should not be modified. "RTN","IBJTPE",4,0) ;; ; "RTN","IBJTPE",5,0) EN ; -- main entry point for IBJT 835 EEOB PRINT "RTN","IBJTPE",6,0) D EN^VALM("IBJT 835 EEOB PRINT") "RTN","IBJTPE",7,0) Q "RTN","IBJTPE",8,0) ; "RTN","IBJTPE",9,0) HDR ; -- header code "RTN","IBJTPE",10,0) S VALMHDR(1)="IBJT 835 EEOB PRINT." "RTN","IBJTPE",11,0) S VALMHDR(2)="Print EEOBs for further investigation" "RTN","IBJTPE",12,0) Q "RTN","IBJTPE",13,0) ; "RTN","IBJTPE",14,0) INIT ; -- init variables and list array "RTN","IBJTPE",15,0) ; Array IBEBERA (From IBJTEP) contains the the EEOBs for this KBILL "RTN","IBJTPE",16,0) N IBRP,IBEIEN,CT,DIR,EOBLST,IBEBERA,IBPERA,JJ,X,Y,DTOUT,DUOUT,DIROUT,DIRUT,IBNUM,IBPEOB,IBALL "RTN","IBJTPE",17,0) S IBNUM=1,(CT,EOBLST,IBALL)=0,JJ="" "RTN","IBJTPE",18,0) D FULL^VALM1 "RTN","IBJTPE",19,0) IN1 ; "RTN","IBJTPE",20,0) S IBRP(U)=", " "RTN","IBJTPE",21,0) ; ERALST is from IBJTEP and will be cleaned up there "RTN","IBJTPE",22,0) I $L(ERALST)=0 W !,"No ERA Information for Bill: "_EPBILL K DIR S DIR(0)="E" D ^DIR K DIR G INITQ "RTN","IBJTPE",23,0) I $L(ERALST,U)=1 S IBPERA=ERALST G IN2 "RTN","IBJTPE",24,0) S DIR("A")="Enter a SINGLE ERA# or (A)LL ERAs/All EEOBs to print: ",DIR(0)="FA^1:15" "RTN","IBJTPE",25,0) S DIR("A",1)="This claim has EEOBs on multiple ERAs. Enter a SINGLE ERA# from the following" "RTN","IBJTPE",26,0) S DIR("A",2)="list or enter ALL to print ALL associated EEOBS from all ERAs in the list." "RTN","IBJTPE",27,0) S DIR("A",3)="Available ERAs: "_$$REPLACE^XLFSTR(ERALST,.IBRP) "RTN","IBJTPE",28,0) S DIR("PRE")="S X=$$UP^XLFSTR(X)" "RTN","IBJTPE",29,0) D ^DIR K DIR "RTN","IBJTPE",30,0) I $D(DTOUT)!$D(DUOUT)!(Y="") S VALMQUIT="" G INITQ "RTN","IBJTPE",31,0) I Y=$E("ALL",1,$L(Y)) S IBALL=1 G IND ; Print All EOBs for All ERAs "RTN","IBJTPE",32,0) S IBPERA=Y I (U_ERALST_U)'[(U_Y_U) W !!,"ERA: "_Y_" not a valid selection. Please try again...",! S X="",IBPERA="" G IN1 "RTN","IBJTPE",33,0) IN2 ; "RTN","IBJTPE",34,0) ; EPBILL is from IBJTEP and will be cleaned up there "RTN","IBJTPE",35,0) K IBEBERA D EEOB^IBJTEP1("IBEBERA",IBPERA,EPBILL,1) S JJ="" F S JJ=$O(IBEBERA(JJ)) Q:JJ="" S CT=CT+1,EOBLST(CT)=$O(IBEBERA(JJ,"")) "RTN","IBJTPE",36,0) I CT=1 S IBPEOB="1," G IND "RTN","IBJTPE",37,0) ; Get the EOB to Print if more than one. "RTN","IBJTPE",38,0) S IBRNG="1-"_IBEBERA "RTN","IBJTPE",39,0) S DIR("A")="Select EEOB# to Print ("_IBRNG_"), (A)ll EEOBs or (E)xit: ",DIR(0)="LA^1:"_IBEBERA "RTN","IBJTPE",40,0) S DIR("PRE")="S X=$S(""Aa""[$E(X):"""_IBRNG_""",""Ee""[$E(X):""^"",1:X)" "RTN","IBJTPE",41,0) D ^DIR K DIR "RTN","IBJTPE",42,0) I $D(DTOUT)!$D(DUOUT)!(Y="") S VALMQUIT=1 G INITQ "RTN","IBJTPE",43,0) ; IBPEOB will be a list of numbers to print "RTN","IBJTPE",44,0) S IBPEOB=Y "RTN","IBJTPE",45,0) ; Ask device "RTN","IBJTPE",46,0) IND N POP S %ZIS="QM" D ^%ZIS I POP S VALMQUIT="" G INITQ "RTN","IBJTPE",47,0) I $D(IO("Q")) D S VALMQUIT="" G INITQ "RTN","IBJTPE",48,0) . S ZTRTN=$S(IBALL=1:"EOBALL^IBJTPE",1:"EOBOUT^IBJTPE"),ZTDESC="AR EDI - Print EEOB Detail from 835 Information" "RTN","IBJTPE",49,0) . S ZTSAVE("IB*")="",ZTSAVE("EOB*")="" "RTN","IBJTPE",50,0) . D ^%ZTLOAD "RTN","IBJTPE",51,0) . W !!,$S($D(ZTSK):"Your task number "_ZTSK_" has been queued.",1:"Unable to queue this job.") "RTN","IBJTPE",52,0) . K ZTSK,IO("Q") D HOME^%ZIS "RTN","IBJTPE",53,0) U IO "RTN","IBJTPE",54,0) ; If IBALL set, print all EOBs on all ERAs otherwise print just selected EOBs/ERAs "RTN","IBJTPE",55,0) G EOBALL:IBALL,EOBOUT "RTN","IBJTPE",56,0) ; "RTN","IBJTPE",57,0) INITQ ; "RTN","IBJTPE",58,0) S VALMQUIT="" "RTN","IBJTPE",59,0) K IBEOB,EOBLST,IBRNG "RTN","IBJTPE",60,0) Q "RTN","IBJTPE",61,0) ; "RTN","IBJTPE",62,0) HELP ; -- help code "RTN","IBJTPE",63,0) S X="?" D DISP^XQORM1 W !! "RTN","IBJTPE",64,0) Q "RTN","IBJTPE",65,0) ; "RTN","IBJTPE",66,0) EXIT ; -- exit code "RTN","IBJTPE",67,0) Q "RTN","IBJTPE",68,0) ; "RTN","IBJTPE",69,0) EXPND ; -- expand code "RTN","IBJTPE",70,0) Q "RTN","IBJTPE",71,0) ; "RTN","IBJTPE",72,0) EOBALL ; Entry point to print all ERAs and all EOBs "RTN","IBJTPE",73,0) N ZQ,ZQL,IBPERA,JJ,IBEBERA,CT,IBSL,IBPG,BB,IBQUIT,IBREPG ; IB*2.0*609 "RTN","IBJTPE",74,0) S (IBPG,IBQUIT,IBREPG,IBSL)=0,ZQL=$L(ERALST,U) "RTN","IBJTPE",75,0) F ZQ=1:1 S IBPERA=$P(ERALST,U,ZQ) Q:IBPERA="" S:IBPG>0 IBREPG=1 D Q:IBQUIT "RTN","IBJTPE",76,0) . K IBEBERA D EEOB^IBJTEP1("IBEBERA",IBPERA,EPBILL,1) S JJ="",CT=0 F S JJ=$O(IBEBERA(JJ)) Q:JJ="" S CT=CT+1,EOBLST(CT)=$O(IBEBERA(JJ,"")) "RTN","IBJTPE",77,0) . S IBSL=0 ; Print new page because we are switching ERA #s "RTN","IBJTPE",78,0) . ; IB*2.0*609 - eliminate use of IBPEOB variable to fix crash when printing ALL EEOBs "RTN","IBJTPE",79,0) . S BB="" F S BB=$O(EOBLST(BB)) Q:BB="" S IBEIEN=EOBLST(BB) D EBO Q:IBQUIT "RTN","IBJTPE",80,0) . I ZQ1 Q:IBQUIT ; This EEOB was split display split payment information "RTN","IBJTPE",131,0) . N SPL "RTN","IBJTPE",132,0) . D SET("** A/R CORRECTED PAYMENT DATA:") Q:IBQUIT "RTN","IBJTPE",133,0) . D SET(" TOTAL AMT PD: "_$J(IBEOB(361.1,IBEIEN_",",1.01,"E"),9,2)) Q:IBQUIT "RTN","IBJTPE",134,0) . S SPL="" F S SPL=$O(IBSPL(361.18,SPL)) Q:SPL="" D Q:IBQUIT "RTN","IBJTPE",135,0) .. D SET(" "_$S(IBSPL(361.18,SPL,.03,"I")'="":$$BN1^PRCAFN(IBSPL(361.18,SPL,.03,"I"))_$J("",8),1:"[suspense] "_IBSPL(361.18,SPL,.01,"E"))_" "_$J(IBSPL(361.18,SPL,.02,"E"),9,2)) Q:IBQUIT "RTN","IBJTPE",136,0) . D SET(" ") Q:IBQUIT "RTN","IBJTPE",137,0) D SET("CLAIM LEVEL PAY STATUS:") Q:IBQUIT "RTN","IBJTPE",138,0) D SET(" Total Submitted Charges :"_$J($G(IBEOB("361.1",IBEIEN_",","2.04","E")),11,2)_" Payer Covered Amount :"_$J($G(IBEOB("361.1",IBEIEN_",","1.03","E")),11,2)) Q:IBQUIT "RTN","IBJTPE",139,0) D SET(" Payer Paid Amount :"_$J($G(IBEOB("361.1",IBEIEN_",","1.01","E")),11,2)_" MEDICARE Allowed Amount :"_$J($G(IBEOB("361.1",IBEIEN_",","2.03","E")),11,2)) Q:IBQUIT "RTN","IBJTPE",140,0) D SET(" Patient Responsibility :"_$J($G(IBEOB("361.1",IBEIEN_",","1.02","E")),11,2)_" % Collected :"_$J(+IBCOL,11,0)_" %") Q:IBQUIT ; IB*2.0*609 "RTN","IBJTPE",141,0) D SET("--------------------------------------------------------------------------------") Q:IBQUIT "RTN","IBJTPE",142,0) D SET("CLAIM LEVEL ADJUSTMENTS:") Q:IBQUIT "RTN","IBJTPE",143,0) S AA="",ACNT=0 F S AA=$O(IBGX(361.11,AA)) Q:AA="" S ACNT=ACNT+1,AQ="" D Q:IBQUIT "RTN","IBJTPE",144,0) . S CC=AA F S CC=$O(IBGX(361.111,CC)) Q:$E(CC,1,$L(AA))'=AA D Q:IBQUIT "RTN","IBJTPE",145,0) .. I AQ="" S AQ=$J(ACNT,3)_") " "RTN","IBJTPE",146,0) .. E S ACNT=ACNT+1,AQ=$J(ACNT,3)_") " "RTN","IBJTPE",147,0) .. D SET(AQ_"ADJ. AMT: "_$J(IBGX(361.111,CC,.02,"E"),9,2)_" ADJ GROUP: "_IBGX(361.11,AA,.01,"I")_" => "_IBGX(361.11,AA,.01,"E")) Q:IBQUIT "RTN","IBJTPE",148,0) .. S RMIEN=$$FIND1^DIC(345,"","BX",IBGX(361.111,CC,.01,"E"),"","","IBPERR") "RTN","IBJTPE",149,0) .. I RMIEN'="" K IBPERR,RCRDC,RCFLD S RCXY=$$GET1^DIQ(345,RMIEN_",",4,"","RCRDC","IBPERR") D DLN^IBJTEP1("RCRDC","RCFLD",57,69) "RTN","IBJTPE",150,0) .. D SET(" ADJ. CODE: "_IBGX(361.111,CC,.01,"E")_" => "_RCFLD(1)) Q:IBQUIT "RTN","IBJTPE",151,0) .. I RCFLD>1 F II=2:1:RCFLD D SET(" "_RCFLD(II)) Q:IBQUIT "RTN","IBJTPE",152,0) I ACNT=0 D SET(" -- None --") Q:IBQUIT "RTN","IBJTPE",153,0) D:'IBQUIT SET("CLAIM LEVEL REMARKS: ") Q:IBQUIT "RTN","IBJTPE",154,0) S RCRC=0 F II="3.03","3.04","3.05","3.06","3.07" D:IBEOB("361.1",IBEIEN_",",II,"E")'="" Q:IBQUIT "RTN","IBJTPE",155,0) . ; Get IEN for this remark code - if no IEN then need to look at the data "RM1" to "RM5" "RTN","IBJTPE",156,0) . S RMIEN=$$FIND1^DIC(346,"","BX",IBEOB("361.1",IBEIEN_",",II,"E"),"","","IBPERR") "RTN","IBJTPE",157,0) . I RMIEN'="" K IBPERR,RCRDC,RCFLD S RCXY=$$GET1^DIQ(346,RMIEN_",",4,"","RCRDC","IBPERR") D DLN^IBJTEP1("RCRDC","RCFLD",50,68) "RTN","IBJTPE",158,0) . I RMIEN="" S RCFLD=$S(II="3.03":5.011,II="3.04":5.021,II="3.05":5.031,II="3.06":5.041,II="3.07":5.051,1:5.011) S RCRLN=$$GET1^DIQ(361.1,IBEIEN_",",RCFLD) "RTN","IBJTPE",159,0) . S RCRC=RCRC+1 D SET(" --- REMARK CODE("_RCRC_"): "_IBEOB("361.1",IBEIEN_",",II,"E")_" => "_RCFLD(1)) Q:IBQUIT "RTN","IBJTPE",160,0) . I RCFLD>1 F II=2:1:RCFLD D SET(" "_RCFLD(II)) Q:IBQUIT "RTN","IBJTPE",161,0) I RCRC=0 D SET(" -- None --") Q:IBQUIT "RTN","IBJTPE",162,0) D:'IBQUIT SET("--------------------------------------------------------------------------------") Q:IBQUIT "RTN","IBJTPE",163,0) ; Walk through the line level information... "RTN","IBJTPE",164,0) D SET("EEOB LINE LEVEL ADJUSTMENTS:") Q:IBQUIT "RTN","IBJTPE",165,0) S RCPL=0,EE="" F S EE=$O(IBCL(361.115,EE)) Q:EE="" S RCPL=RCPL+1 D Q:IBQUIT "RTN","IBJTPE",166,0) . S QQ=EE,RCMD="" F S QQ=$O(IBCL(361.1152,QQ)) Q:$E(QQ,1,$L(EE))'=EE S RCMD=IBCL(361.1152,QQ,.01,"I") "RTN","IBJTPE",167,0) . D SET(" # SV DT REVCD PROC MOD UNITS BILLED DEDUCT COINS ALLOW PYMT") Q:IBQUIT "RTN","IBJTPE",168,0) . S RCBAMT=$$BILLN^IBJTEP1(IBEOB(361.1,IBEIEN_",",.01,"I"),IBCL(361.115,EE,.1,"E"),IBCL(361.115,EE,.04,"E")) "RTN","IBJTPE",169,0) . S RCDED=$$ADJU^IBJTEP1("DEDUCT",.IBCL,EE),RCOIN=$$ADJU^IBJTEP1("COINS",.IBCL,EE) ; Get Deductable and Co-Insurance amts. "RTN","IBJTPE",170,0) . S XLN=$J(RCPL,2,0)_" "_$$FMTE^XLFDT(IBCL(361.115,EE,.16,"I"),"2Z")_" "_$$CJ^XLFSTR(IBCL(361.115,EE,.1,"E"),5)_" "_$$CJ^XLFSTR(IBCL(361.115,EE,.04,"E"),8)_$$CJ^XLFSTR(RCMD,5)_" "_$$CJ^XLFSTR(IBCL(361.115,EE,.11,"E"),3) "RTN","IBJTPE",171,0) . D SET(XLN_" "_$J(RCBAMT,9,2)_$J(RCDED,8,2)_$J(RCOIN,8,2)_$J(IBCL(361.115,EE,.13,"E"),9,2)_$J(IBCL(361.115,EE,.03,"E"),9,2)) Q:IBQUIT "RTN","IBJTPE",172,0) . D SET(" ") Q:IBQUIT "RTN","IBJTPE",173,0) . D SET(" Product/Service Description:"_IBCL(361.115,EE,.09,"E")) Q:IBQUIT "RTN","IBJTPE",174,0) . D SET(" Payer Policy Reference:"_$G(IBCL(361.11512,EE,.01,"E"))) Q:IBQUIT "RTN","IBJTPE",175,0) . D SET(" ") Q:IBQUIT "RTN","IBJTPE",176,0) . S ACNT=0,AA=EE F S AA=$O(IBCL(361.1151,AA)) Q:$E(AA,1,$L(EE))'=EE D Q:IBQUIT "RTN","IBJTPE",177,0) .. S ACNT=ACNT+1 "RTN","IBJTPE",178,0) .. S CC=AA,RCRC=0 F S CC=$O(IBCL(361.11511,CC)) Q:$E(CC,1,$L(AA))'=AA D Q:IBQUIT "RTN","IBJTPE",179,0) ... S RCRC=RCRC+1 D SET(" -> ADJ. AMT: "_$J(IBCL(361.11511,CC,.02,"E"),9,2)_" ADJ GROUP: "_IBCL(361.1151,AA,.01,"I")_" - "_IBCL(361.1151,AA,.01,"E")_" "_$$CJ^XLFSTR("QTY: "_+$G(IBCL(361.11511,CC,.03,"E")),8)) Q:IBQUIT "RTN","IBJTPE",180,0) ... S RCXY=$$FIND1^DIC(345,"","BX",IBCL(361.11511,CC,.01,"E"),"","","RCERR") "RTN","IBJTPE",181,0) ... K RCRDC,RCERR S RCXY=$$GET1^DIQ(345,RCXY_",",4,"","RCRDC","RCERR") "RTN","IBJTPE",182,0) ... I $D(RCRDC)>0 K RCFLD D DLN^IBJTEP1("RCRDC","RCFLD",57,57) "RTN","IBJTPE",183,0) ... I $D(RCRDC)=0 K RCFLD S RCRDC(1)=IBCL(361.11511,CC,.04,"E") D DLN^IBJTEP1("RCRDC","RCFLD",57,57) ; If no data from file 345 use data from FMS "RTN","IBJTPE",184,0) ... D SET(" ADJ CODE: "_$$CJ^XLFSTR(IBCL(361.11511,CC,.01,"E"),5)_" "_RCFLD(1)) Q:IBQUIT "RTN","IBJTPE",185,0) ... I RCFLD>1 F II=2:1:RCFLD D SET(" "_RCFLD(II)) Q:IBQUIT "RTN","IBJTPE",186,0) . ; Display RARC Codes for this Line Item "RTN","IBJTPE",187,0) . I $D(IBCL(361.1154))'=0 S QQ=EE,RCMD="" F S QQ=$O(IBCL(361.1154,QQ)) Q:$E(QQ,1,$L(EE))'=EE D Q:IBQUIT "RTN","IBJTPE",188,0) .. S RMIEN=$$FIND1^DIC(346,"","BX",IBCL(361.1154,QQ,.02,"E"),"","","IBERR") "RTN","IBJTPE",189,0) .. I RMIEN'="" K IBPERR,RCRDC,RCFLD S RCXY=$$GET1^DIQ(346,RMIEN_",",4,"","RCRDC","IBPERR") D DLN^IBJTEP1("RCRDC","RCFLD",50,68) "RTN","IBJTPE",190,0) .. D SET(" --- RARC: "_IBCL(361.1154,QQ,.02,"E")_" - "_RCFLD(1)) Q:IBQUIT "RTN","IBJTPE",191,0) .. I RCFLD>1 F II=2:1:RCFLD D SET(" "_RCFLD(II)) Q:IBQUIT "RTN","IBJTPE",192,0) . D:ACNT'=0 SET(" ") Q:IBQUIT "RTN","IBJTPE",193,0) I ACNT=0 D SET(" -- No Line Level Adjustments --") Q:IBQUIT "RTN","IBJTPE",194,0) ; If there are EOB Errors add them to the Report "RTN","IBJTPE",195,0) D:$D(IBEERR(361.1,IBEIEN_",",20))>9 "RTN","IBJTPE",196,0) . D SET(" ") Q:IBQUIT D SET("EEOB MESSAGE ERRORS:") Q:IBQUIT "RTN","IBJTPE",197,0) . N II S II=0 F S II=$O(IBEERR(361.1,IBEIEN_",",20,II)) Q:II="" D SET($G(IBEERR(361.1,IBEIEN_",",20,II))) Q:IBQUIT "RTN","IBJTPE",198,0) D:'IBQUIT SET("================================================================================") Q:IBQUIT "RTN","IBJTPE",199,0) ; "RTN","IBJTPE",200,0) Q "RTN","IBJTPE",201,0) SET(DATA,NEW) ; "RTN","IBJTPE",202,0) I $G(NEW)="" S NEW=1 "RTN","IBJTPE",203,0) W DATA,! S IBSL=IBSL+1 "RTN","IBJTPE",204,0) I IBSL'<(IOSL-4) S IBQUIT=$$NEWPG(.IBPG,NEW,.IBSL,IBPERA) "RTN","IBJTPE",205,0) Q "RTN","IBJTPE",206,0) RHDR(IBSCR,IBDT,IBPG) ;Prints EOB detail report heading "RTN","IBJTPE",207,0) ; IBSCR - IEN of the ERA; IBDT - Report Date; IBPG - page #, passed by reference. "RTN","IBJTPE",208,0) N Z "RTN","IBJTPE",209,0) S Z=$G(^RCY(344.4,IBSCR,0)) "RTN","IBJTPE",210,0) I IBPG!($E(IOST,1,2)="C-") W @IOF,*13 "RTN","IBJTPE",211,0) S IBPG=IBPG+1 "RTN","IBJTPE",212,0) D HDRP("EDI EEOB DETAIL - 835 INFORMATION SCREEN "_$$FMTE^XLFDT(IBDT,2),1,"Page: "_IBPG) "RTN","IBJTPE",213,0) D HDRP($E(" ERA NUMBER: "_IBSCR_$J("",25),1,25)_" ERA DATE: "_$$FMTE^XLFDT($P(Z,U,4)),1) "RTN","IBJTPE",214,0) D HDRP("INS COMPANY: "_$P(Z,U,6)_"/"_$P(Z,U,3),1) "RTN","IBJTPE",215,0) D HDRP("ERA TRACE #: "_$P(Z,U,2),1) "RTN","IBJTPE",216,0) W !,$TR($J("",IOM)," ","="),! "RTN","IBJTPE",217,0) S IBSL=5 "RTN","IBJTPE",218,0) Q "RTN","IBJTPE",219,0) ; "RTN","IBJTPE",220,0) NEWPG(IBPG,IBNEW,IBSL,IBSCR) ; Check for new page needed, output header "RTN","IBJTPE",221,0) ; IBPG = Page number passwd by referece "RTN","IBJTPE",222,0) ; IBNEW = 1 to force new page "RTN","IBJTPE",223,0) ; IBSL = page length passed by reference "RTN","IBJTPE",224,0) ; Function returns 1 if user chooses to stop output "RTN","IBJTPE",225,0) N IBSTOP S IBSTOP=0 "RTN","IBJTPE",226,0) I IBNEW!'IBPG!(IBSL'<(IOSL-4)) D "RTN","IBJTPE",227,0) . D:IBPG ASK(.IBSTOP) I IBSTOP Q "RTN","IBJTPE",228,0) . W @IOF "RTN","IBJTPE",229,0) . D RHDR(IBSCR,IBDT,.IBPG) "RTN","IBJTPE",230,0) Q IBSTOP "RTN","IBJTPE",231,0) ; "RTN","IBJTPE",232,0) ASK(IBSTOP) ; User if you want to quit or continue "RTN","IBJTPE",233,0) S IBSTOP=0 "RTN","IBJTPE",234,0) I $E(IOST,1,2)'["C-" Q "RTN","IBJTPE",235,0) N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y "RTN","IBJTPE",236,0) S DIR(0)="E" W ! D ^DIR "RTN","IBJTPE",237,0) I ($D(DIRUT))!($D(DUOUT)) S IBSTOP=1 Q "RTN","IBJTPE",238,0) Q "RTN","IBJTPE",239,0) ; "RTN","IBJTPE",240,0) HDRP(Z,X,Z1) ; Print Header (Z=String, X=1 (line feed) X=0 (no LF), Z1 (page number right justified) "RTN","IBJTPE",241,0) I X=1 W ! "RTN","IBJTPE",242,0) W ?(IOM-$L(Z)\2),Z W:$G(Z1)]"" ?(IOM-$L(Z1)),Z1 "RTN","IBJTPE",243,0) Q "VER") 8.0^22.2 **END** **END**