BAREDEP ; IHS/SD/TPF - AR ERA PAYMENT CHECKER ; 01/30/2009
;;1.8;IHS ACCOUNTS RECEIVABLE;**5,6,10,20,23,24**;OCT 26,2005;Build 69
;BAR*1.8*6 IHS/SD/TPF MOVE REVERSAL CHECK TO A FULL CLMDA LOOP
;IHS/SD/POT HEAT#82698 NOV 2012 ACCEPT LEADING ZEROES IN CHKECK # (POS)- BAR 1.8*23
;IHS/SD/POT HEAT148388 1/10/2014 ACCEPT REVERSALS FOR TYPE= 1 IF NEG PAYMENT- BAR 1.8*24
;IHS/SD/POT HEAT147572 ALLOW TRIBAL SITES ERA POSTING OF NEG BAL & CANCELLED BILLS- BAR 1.8*24
Q
REVLOOP(IMPDA) ;EP - REVERSAL LOOP
N CLMDA,MATCHES,ERRORS
S CLMDA=0
I $G(BARDBG) W !!,"BEGIN REVERSAL/PAYMENT MATCHING PROCESS"
F S CLMDA=$O(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA)) Q:'CLMDA D
. Q:$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,2)="P" ;DON'T CHECK REVERSALS ALREADY POSTED
. ;Q:$D(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,4,"B",44)) ;DON'T PROCESS USER STATUS OVERRIDE BAR*1.8*6 SCR120
. Q:$$OVERIDE^BAREDEP1(CLMDA) ;MRS:BAR*1.8*10 D159-1 AND 2
. ;;;S REVERSAL=+$$GET1^DIQ(90056.0205,CLMDA_","_IMPDA_",",.11)=22 old code HEAT148388 - BAR 1.8*24
. S REVERSAL=$$ISREV(CLMDA,IMPDA) ; 1/10/2014 P.OTT HEAT148388 - BAR 1.8*24
. ;ONLY REVERSALS WITH A NEGATIVE AMOUNT WILL BE PROCESSED FOR A MATCHING PAYMENT - PER ADRIAN
. I REVERSAL D
..I $G(BARDBG) W !,"SHOULD WE CHECK FOR A MATCHING PAYMENT? ",$$GET1^DIQ(90056.0205,CLMDA_","_IMPDA_",",.01)
..I $G(BARDBG) W !,"ONLY IF E-PAYMENT IS < 0 ",$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,4)
. ;old code I REVERSAL,$$IHS^BARUFUT(DUZ(2)),(+$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,4)<0) D REVCHECK(IMPDA,CLMDA) ;CHECK FOR PAYMENT AND REVERSALS W/IN ERA FILE
. I REVERSAL,$$IHSNEGB^BARUFUT(DUZ(2)),(+$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,4)<0) D REVCHECK(IMPDA,CLMDA) ;HEAT147572 - BAR 1.8*24
Q
REVCHECK(IMPDA,REVDA) ;EP - REVERSAL AND PAYMENT CHECKS
I $G(BARDBG) W !!,"LOOKING FOR MATCHING PAYMENT FOR REVERSAL ",$P($G(^BAREDI("I",DUZ(2),IMPDA,30,REVDA,0)),U)
I $P($G(^BAREDI("I",DUZ(2),IMPDA,30,REVDA,0)),U,2)="P" W:$G(BARDBG) !,"CLAIM ",$P($G(^BAREDI("I",DUZ(2),IMPDA,30,REVDA,0)),U)," ALREADY POSTED"
I $P($G(^BAREDI("I",DUZ(2),IMPDA,30,REVDA,5)),U)=139 W:$G(BARDBG) !,"CLAIM ",$P($G(^BAREDI("I",DUZ(2),IMPDA,30,REVDA,0)),U)," ALREADY CREDIT FROM"
I $P($G(^BAREDI("I",DUZ(2),IMPDA,30,REVDA,5)),U)=138 W:$G(BARDBG) !,"CLAIM ",$P($G(^BAREDI("I",DUZ(2),IMPDA,30,REVDA,0)),U)," ALREADY CREDIT TO"
I $P($G(^BAREDI("I",DUZ(2),IMPDA,30,REVDA,1)),U)="" W:$G(BARDBG) !,"CLAIM ",$P($G(^BAREDI("I",DUZ(2),IMPDA,30,REVDA,0)),U)," NO A-CLAIM"
;N MATCHES,ERRORS BAR*1.8*6 MOVE UP TO REVLOOP
S (MATCHES,NOMATCH)=0
D INBILL(IMPDA,REVDA,.MATCHES,.NOMATCH)
Q:$G(MATCHES)=1
S (MATCHES,NOMATCH)=0
D INERA(IMPDA,REVDA,.MATCHES,.NOMATCH) ;NOW CHECK INSIDE ERA FILE FOR MATHES
Q:$G(MATCHES)=1 ; IF MATCH FOUND IN ERA FILE THEN YOU'RE DONE
S (MATCHES,NOMATCH)=0
D INRPMS(IMPDA,REVDA,.MATCHES,.NOMATCH)
I $G(MATCHES)=0 D
.I $G(BARDBG) W !!,"MATCHING PAYMENT NOT FOUND FOR REVERSAL!"
.S ERRORS("PT NF E")=""
.D ADDREAS^BAREDP04(IMPDA,REVDA,.ERRORS)
.K ERRORS
Q
INBILL(IMPDA,REVDA,MATCHES,NOMATCH) ;EP - SEARCH FOR MATCHES WITHIN BILL
N CLIENS,CLBILL,CLPAYMNT,CLSTATUS,CLCHECK,PAYMENTS,REVICN,CLMICN,CNT
N CLMDA ;BAR*1.8*6
S REVCHECK=$$GET1^DIQ(90056.0205,REVDA_","_IMPDA_",",201,"E") ;CHECK/EFT TRACE
S REVBILL=$$GET1^DIQ(90056.0205,REVDA_","_IMPDA_",",.01,"E") ;E-CLAIM (AR BILL
S REVAMT=-$$GET1^DIQ(90056.0205,REVDA_","_IMPDA_",",.04,"E") ;E-PAYMENT
;S REVAMT=-$$GET1^DIQ(90056.0205,REVDA_","_IMPDA_",",.05,"E") ;E-BILLED
S REVICN=$$GET1^DIQ(90056.0205,REVDA_","_IMPDA_",",302,"E") ;PAYER CLAIM CONTROL # (ICN)
;IF REVICN CONTAINS AN 'R' THIS IS A MEDICARE REVERSAL
I $G(BARDBG) W !!,"LOOKING FOR MATCHING PAYMENT FOR ",-REVAMT," WITHIN BILL ",REVBILL
S PAYMENTS=0
S CLMDA=""
F CNT=1:1 S CLMDA=$O(^BAREDI("I",DUZ(2),IMPDA,30,"B",REVBILL,CLMDA)) Q:CLMDA="" D
.W:'(CNT#1000) "."
.Q:$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,2)="P" ;DON'T CHECK POSTED CLAIMS
.Q:REVDA=CLMDA ;DO NOT PROCESS REVERSAL CLAIM WE FOUND IN BAREDP04
.S CLIENS=CLMDA_","_IMPDA_","
.;Q:$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,1)),U)="" ;IF NOT MATCHED DON'T COMPARE ;bar*1.8*20 REQ4
.S CLSTATUS=$P($$GET1^DIQ(90056.0205,CLIENS,.11,"E")," ") ;E-CLAIM STATUS CODE (CLP02)
.I CLSTATUS="" S CLSTATUS=$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,2)),U,4) ;MRS:BAR*1.8*10 H2555
.I CLSTATUS=22 Q ;DON'T LOOK AT OTHER REVERSALS
.Q:(U_"1"_U_"2"_U_"3"_U_"19"_U_"20"_U_"21"_U)'[(U_CLSTATUS_U) ;PRIMARY,SECONDARY,TERTIARY AS WELL AS THOSE 19,20,21 FORWARDED TO ADDITIONAL PAYER
.S POSTAS=$$GET1^DIQ(90056.0205,CLIENS,501,"I") ;POST THIS CLAIM AS TYPE
.Q:POSTAS=138!(POSTAS=139) ;DON'T TRY TO MATCH A REVERSAL TO A PAYMENT ALREADY MATCHED
.S CLMICN=$$GET1^DIQ(90056.0205,CLIENS,302,"E") ;PAYER CLAIM CONTROL # (ICN)
.S PAYMENTS=PAYMENTS+1
.S CLPAYMNT=$$GET1^DIQ(90056.0205,CLIENS,.04,"E") ;E-PAYMENT
.I REVICN["R" D Q
..I (CLPAYMNT=REVAMT) D
...S MATCHES=MATCHES+1
...S MATCHES(IMPDA,CLMDA,REVDA)=""
..E S NOMATCH=NOMATCH+1 S NOMATCH(IMPDA,CLMDA,REVDA)=""
.I REVAMT=CLPAYMNT D
..S MATCHES=MATCHES+1
..S MATCHES(IMPDA,CLMDA,REVDA)=""
.E S NOMATCH=NOMATCH+1 S NOMATCH(IMPDA,CLMDA,REVDA)=""
Q:'PAYMENTS!'MATCHES
I REVICN["R" D MCRERRS(.MATCHES,.NOMATCH,PAYMENTS,"INBILL") I 1
E D REGERRS(.MATCHES,.NOMATCH,PAYMENTS,"INBILL")
K ERRORS
Q
INERA(IMPDA,REVDA,MATCHES,NOMATCH) ;EP - FIND PAYMENTS AND REVERSAL W/IN ERA FILE
N CLIENS,CLBILL,CLPAYMNT,CLSTATUS,CLCHECK,PAYMENTS,REVICN,CLMICN,CNT
N CLMDA ;BAR*1.8*6
S REVCHECK=$$GET1^DIQ(90056.0205,REVDA_","_IMPDA_",",201,"E") ;CHECK/EFT TRACE
S REVBILL=$$GET1^DIQ(90056.0205,REVDA_","_IMPDA_",",.01,"E") ;E-CLAIM (AR BILL
S REVAMT=-$$GET1^DIQ(90056.0205,REVDA_","_IMPDA_",",.04,"E") ;E-PAYMENT
S REVICN=$$GET1^DIQ(90056.0205,REVDA_","_IMPDA_",",302,"E") ;PAYER CLAIM CONTROL # (ICN)
S ERAFILE=$$GET1^DIQ(90056.02,IMPDA_",",.01,"E") ;CHECK/EFT TRACE
;IF REVICN CONTAINS AN 'R' THIS IS A MEDICARE REVERSAL
I $G(BARDBG) W !!,"LOOKING FOR MATCHING PAYMENT FOR ",-REVAMT," IN ERA FILE ",ERAFILE
S PAYMENTS=0
S NOMATCH=0
S CLMDA=0
F CNT=1:1 S CLMDA=$O(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA)) Q:'CLMDA!(MATCHES) D
.W:'(CNT#1000) "."
.Q:$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,2)="P" ;DON'T CHECK POSTED CLAIMS
.S CLCHECK=$$GET1^DIQ(90056.0205,CLMDA_","_IMPDA_",",201,"E") ;CHECK/EFT TRACE
.Q:CLCHECK'=REVCHECK
.Q:REVDA=CLMDA ;DO NOT PROCESS REVERSAL CLAIM WE FOUND
.S CLIENS=CLMDA_","_IMPDA_","
.Q:$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,1)),U)="" ;IF NOT MATCHED DON'T COMPARE
.S CLSTATUS=$P($$GET1^DIQ(90056.0205,CLIENS,.11,"E")," ") ;E-CLAIM STATUS CODE (CLP02)
.I CLSTATUS="" S CLSTATUS=$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,2)),U,4) ;MRS:BAR*1.8*10 H2555
.I CLSTATUS=22 Q ;DON'T LOOK AT OTHER REVERSALS,SHOULD WE SKIP ANY OTHERS?
.Q:(U_"1"_U_"2"_U_"3"_U_"19"_U_"20"_U_"21"_U)'[(U_CLSTATUS_U) ;PRIMARY,SECONDARY,TERTIARY AS WELL AS THOSE 19,20,21 FORWARDED TO ADDITIONAL PAYER
.S POSTAS=$$GET1^DIQ(90056.0205,CLIENS,501,"I") ;POST THIS CLAIM AS TYPE
.Q:POSTAS=138!(POSTAS=139) ;DON'T TRY TO MATCH A REVERSAL TO A PAYMENT ALREADY MATCHED
.S PAYMENTS=PAYMENTS+1
.I $G(BARDBG) W !?15,"SEARCHING FOR PAYMENT TO MATCH REV OF ",REVAMT
.S CLBILL=$$GET1^DIQ(90056.0205,CLIENS,.01,"E") ;E-CLAIM (AR BILL
.Q:CLBILL=REVBILL ;ALREADY CHECKED WITHIN THE BILL FOR MATCHES, NOW CHECK OTHER BILLS IN ERA FILE
.I $G(BARDBG) W !?20,"REV BILL ",REVBILL,!?20,"CL BILL ",CLBILL
.S CLMICN=$$GET1^DIQ(90056.0205,CLIENS,302,"E") ;PAYER CLAIM CONMTROL # (ICN)
.S CLPAYMNT=$$GET1^DIQ(90056.0205,CLIENS,.04,"E") ;E-PAYMENT
.;S CLPAYMNT=$$GET1^DIQ(90056.0205,CLIENS,.05,"E") ;E-BILL
.;MEDICARE MATCH?
.I REVICN["R" D Q
..I CLMICN=$TR(REVICN,"R") D
...S MATCHES=MATCHES+1
...S MATCHES(IMPDA,CLMDA,REVDA)=""
..E S NOMATCH=NOMATCH+1 S NOMATCH(IMPDA,CLMDA,REVDA)=""
.;REGULAR MATCH?
.I CLPAYMNT=REVAMT D Q
..S MATCHES=MATCHES+1
..S MATCHES(IMPDA,CLMDA,REVDA)=""
.E S NOMATCH=NOMATCH+1 S NOMATCH(IMPDA,CLMDA,REVDA)=""
Q:'MATCHES!'PAYMENTS
I REVICN["R" D MCRERRS(.MCRMATCH,.MCRNOMAT,PAYMENTS,"INERA") I 1
E D REGERRS(.MATCHES,.NOMATCH,PAYMENTS,"INERA")
K ERRORS
Q
INRPMS(IMPDA,REVDA,MATCHES,NOMATCH) ;EP - LOOK FOR MATCHING PAYMENT IN A/R BILL
N REVAMT,REVBILL,ERACHECK,BARBLIEN,FOUND,REVDATE,COLDA,ITEMDA,REVSCHED,REVERSAL,TAMOUNT
N TRANS,BARFROM,BARTO,BARTYPE
N CLMDA ;BAR*1.8*6
I $G(BARDBG) W !!,"LOOKING FOR MATCHING PAYMENT IN RPMS"
S REVAMT=$$GET1^DIQ(90056.0205,REVDA_","_IMPDA_",",.04,"E") ;E-CLAIM PAYMENT
S REVBILL=$$GET1^DIQ(90056.0205,REVDA_","_IMPDA_",",.01,"E") ;E-CLAIM
S REVCHECK=$$GET1^DIQ(90056.0205,REVDA_","_IMPDA_",",201,"E") ;CHECK/EFT TRACE
S POSTAS=$$GET1^DIQ(90056.0205,REVDA_","_IMPDA_",",501,"I") ;POST THIS CLAIM AS TYPE
Q:POSTAS=138!(POSTAS=139)
S CLMDA=0,BILLCHOS=""
F S CLMDA=$O(^BAREDI("I",DUZ(2),IMPDA,30,"B",BARBILL,CLMDA)) Q:'CLMDA!(BILLCHOS'="") D
.S BILLCHOS=$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,1)),U) ;A-CLAIM ; IF THIS IS POPULATED THEN THE CORRECT BILL WAS FOUND OR CHOSEN ALREADY
I BILLCHOS S BARBLIEN=BILLCHOS
E S BARBLIEN=$$GETIEN^BAREDEB("B",BARBILL)
I BARBLIEN="BILL NOT FOUND" D Q
.S CLMDA=$O(^BAREDI("I",DUZ(2),IMPDA,30,"B",BARBILL,""))
.I '$D(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,4,"B",11)) D
..S ERRORS("BL NF")="" ;BILL NOT FOUND IN RPMS. SET ONLY IF OLD ERROR 11 NOT SET
.D ADDREAS^BAREDP04(IMPDA,REVDA,.ERRORS)
.K ERRORS
I BARBLIEN="DUPLICATE BILLS FOUND" D Q
.S ERRORS("DUPB")="" ;DUPLICATE BILLS FOUND IN RPMS
.D ADDREAS^BAREDP04(IMPDA,REVDA,.ERRORS)
.K ERRORS
Q:'BARBLIEN 0
S FOUND=0
S REVERSAL=0 ;NUMBER OF REVERSALS ALREADY SET UP FOR THIS AMOUNT.
S TRANS=""
F S TRANS=$O(^BARTR(DUZ(2),"AC",BARBLIEN,TRANS),-1) Q:'TRANS!(FOUND) D ;REVERSAL CAN NOT APPLY TO A FUTURE PAYMENT
.S TRANTYPE=$$GET1^DIQ(90050.03,TRANS_",",101,"E")
.Q:TRANTYPE'="PAYMENT"&(TRANTYPE'="PAYMENT CREDIT") ;OLD WILL BILL 'PAYMENT', NEW STUFF WILL BE 'PAYMENT CREDIT'
.S TAMOUNT=$$GET1^DIQ(90050.03,TRANS_",",3.5,"E")
.I TAMOUNT=REVAMT,$$GET1^DIQ(90050.03,TRANS_",",110,"I") S REVERSAL=REVERSAL+1 Q ;#110 = DATE OF TRANSACTION REVERSED
.I TAMOUNT=-REVAMT D
..S COLDA=$$GET1^DIQ(90050.03,TRANS_",",14,"I")
..S ITEMDA=$$GET1^DIQ(90050.03,TRANS_",",15,"I")
..;;;Q:'$D(^BARCOL(DUZ(2),"D",REVCHECK,COLDA,ITEMDA)) ;IF COLLECTION BATCH AND ITEM DON'T MATCH UP WE CAN'T POST
.. I '$D(^BARCOL(DUZ(2),"D",REVCHECK,COLDA,ITEMDA)),'$D(^BARCOL(DUZ(2),"D",+REVCHECK,COLDA,ITEMDA)) Q ;- BAR 1.8*23
..I REVERSAL S REVERSAL=REVERSAL-1 Q ;MATCHING REVERSAL SO THIS PAYMENT MATCHES
..S FOUND=FOUND+1
..S REVDATE=$$GET1^DIQ(90050.03,TRANS_",",.01,"I")
..S REVSCHED=$$GET1^DIQ(90051.01,COLDA_",",28,"I")
..I REVSCHED="" S REVSCHED=$$GET1^DIQ(90051.1101,ITEMDA_","_COLDA_",",20,"I")
..S:REVSCHED="" REVSCHED="PRE-UFMS_COLLECTIONS"
I 'FOUND D Q
.S ERRORS("PR NM R")="" ;MATCHING PAYMENT NOT FOUND IN A/R TRANSACTION FILE
.D ADDREAS^BAREDP04(IMPDA,REVDA,.ERRORS)
.K ERRORS
;NOW WE SHOULD HAVE A NON-MATCHED PAYMENT EQUALING OUR ERA REVERSAL
K DIE,DIC,DR,DA,DIR
S BARFROM=$$GET1^DIQ(90056.0205,REVDA_","_IMPDA_",",1.01,"I")
S BARTO=$G(BARBLIEN)
Q:BARFROM="" ;DON'T MATCH TO A NON-MATCHED CLAIM
S DIE=$$DIC^XBDIQ1(90056.0205)
S BARTYPE=139
;S DR=DR=DR_"501///^S X=BARTYPE" ;CREDIT TO OTHER BILL
S DR="501///^S X=BARTYPE" ;CREDIT TO OTHER BILL BAR*1.8*6 IM29724
S DR=DR_";.12///^S X=REVDATE"
S DR=DR_";301///^S X=REVSCHED"
S DR=DR_";602///^S X=BARFROM"
S DR=DR_";601///^S X=BARTO"
S DA(1)=IMPDA
S DA=REVDA
D ^DIE
;HAD TROUBLE GETTING THE DIE CALL TO WORK FOR .12 AND 301
S $P(^BAREDI("I",DUZ(2),DA(1),30,DA,0),U,12)=REVDATE
S $P(^BAREDI("I",DUZ(2),DA(1),30,DA,3),U)=REVSCHED
K DR,DIE,DIC,DIR
K ERRORS
Q
MCRERRS(MATCHES,NOMATCH,PAYMENTS,WHERE) ;EP - MCR ERRORS
N ERRORS,CLMDA
I MATCHES=1 D SETMATCH(.MATCHES) Q
I PAYMENTS=0 D
.I WHERE="INBILL" S ERRORS("PT NF B")=""
.E S ERRORS("PT NF E")=""
.D ADDREAS^BAREDP04(IMPDA,REVDA,.ERRORS)
I MATCHES>0 D
.I WHERE="INBILL" S ERRORS("MP MCR B")=""
.E S ERRORS("MP MCR E")=""
.D ADDREAS^BAREDP04(IMPDA,REVDA,.ERRORS)
.S CLMDA=""
.F S CLMDA=$O(MATCHES(IMPDA,CLMDA)) Q:'CLMDA D
..D ADDREAS^BAREDP04(IMPDA,CLMDA,.ERRORS)
I NOMATCH>0 D
.I WHERE="INBILL" S ERRORS("NM MCR B")=""
.E S ERRORS("NM MCR E")=""
.D ADDREAS^BAREDP04(IMPDA,REVDA,.ERRORS)
.S CLMDA=""
.F S CLMDA=$O(NOMATCH(IMPDA,CLMDA)) Q:'CLMDA D
..D ADDREAS^BAREDP04(IMPDA,CLMDA,.ERRORS)
K ERRORS
Q
REGERRS(MATCHES,NOMATCH,PAYMENTS,WHERE) ; EP
N ERRORS,CLMDA
I MATCHES=1 D SETMATCH(.MATCHES) Q
I PAYMENTS=0 D
.I WHERE="INBILL" S ERRORS("PT NF B")=""
.E S ERRORS("PT NF E")=""
.D ADDREAS^BAREDP04(IMPDA,REVDA,.ERRORS)
I MATCHES>1 D
.I WHERE="INBILL" S ERRORS("MPB")=""
.E S ERRORS("MPE")=""
.D ADDREAS^BAREDP04(IMPDA,REVDA,.ERRORS)
.S CLMDA=""
.F S CLMDA=$O(MATCHES(IMPDA,CLMDA)) Q:'CLMDA D
..D ADDREAS^BAREDP04(IMPDA,CLMDA,.ERRORS)
I NOMATCH>0 D
.I WHERE="INBILL" S ERRORS("PR NM B")=""
.E S ERRORS("PR NM E")=""
.D ADDREAS^BAREDP04(IMPDA,REVDA,.ERRORS)
.S CLMDA=""
.F S CLMDA=$O(NOMATCH(IMPDA,CLMDA)) Q:'CLMDA D
..D ADDREAS^BAREDP04(IMPDA,CLMDA,.ERRORS)
K ERRORS
Q
SETMATCH(MATCH) ;EP - SET TO MATCHING AND SET TRANSACTION TYPE
N IMPDA,CLMDA,REVDA,CLIENS,REVIENS,BARFROM,BARTO,CNT
S IMPDA=$O(MATCH(""))
Q:IMPDA=""
S CLMDA=$O(MATCH(IMPDA,""))
Q:CLMDA=""
S REVDA=$O(MATCH(IMPDA,CLMDA,""))
Q:REVDA=""
S CLIENS=CLMDA_","_IMPDA_","
S REVIENS=REVDA_","_IMPDA_","
I $O(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,4,0)) Q
I $O(^BAREDI("I",DUZ(2),IMPDA,30,REVDA,4,0)) Q
I $G(BARDBG) W !!,"PAYMENT REVERSAL: ",$$GET1^DIQ(90056.0205,CLIENS,.01,"E")
I $G(BARDBG) W !,"MATCHED TO REVERSAL: ",$$GET1^DIQ(90056.0205,REVIENS,.01,"E")
S BARFROM=$$GET1^DIQ(90056.0205,REVIENS,1.01,"I")
S BARTO=$$GET1^DIQ(90056.0205,CLIENS,1.01,"I")
Q:BARFROM=""!(BARTO="") ;DO NOT MATCH TO A NON-MATCHED CLAIM
I $G(BARDBG) W !,"PAYMENT CREDIT APPLIED FROM: ",BARFROM
I $G(BARDBG) W !,"PAYMENT CREDIT APPLIED TO: ",BARTO
K DA S CNT=0
F DA=CLMDA,REVDA D
.S CNT=CNT+1
.K DR,DIE,DIC,DIR
.S DIE=$$DIC^XBDIQ1(90056.0205)
.I CNT=1 S TYPE=139 ;CREDIT FROM OTHER BILL
.E S TYPE=138 ;CREDIT TO OTHER BILL
.S STAT="M"
.S DR=".02///^S X=STAT"
.S DR=DR_";501///^S X=TYPE"
.I CNT=1 S DR=DR_";602///^S X=BARFROM"
.E S DR=DR_";601///^S X=BARTO"
.S DA(1)=IMPDA
.D ^DIE
.K DR,DIE,DIC,DIR
Q
ISREV(CLMDA,IMPDA) ;HEAT148388- BAR 1.8*24
I +$$GET1^DIQ(90056.0205,CLMDA_","_IMPDA_",",.11)=22 Q 1
Q 0
;----------------
BAREDEP ; IHS/SD/TPF - AR ERA PAYMENT CHECKER ; 01/30/2009
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**5,6,10,20,23,24**;OCT 26,2005;Build 69
+2 ;BAR*1.8*6 IHS/SD/TPF MOVE REVERSAL CHECK TO A FULL CLMDA LOOP
+3 ;IHS/SD/POT HEAT#82698 NOV 2012 ACCEPT LEADING ZEROES IN CHKECK # (POS)- BAR 1.8*23
+4 ;IHS/SD/POT HEAT148388 1/10/2014 ACCEPT REVERSALS FOR TYPE= 1 IF NEG PAYMENT- BAR 1.8*24
+5 ;IHS/SD/POT HEAT147572 ALLOW TRIBAL SITES ERA POSTING OF NEG BAL & CANCELLED BILLS- BAR 1.8*24
+6 QUIT
REVLOOP(IMPDA) ;EP - REVERSAL LOOP
+1 NEW CLMDA,MATCHES,ERRORS
+2 SET CLMDA=0
+3 IF $GET(BARDBG)
WRITE !!,"BEGIN REVERSAL/PAYMENT MATCHING PROCESS"
+4 FOR
SET CLMDA=$ORDER(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA))
IF 'CLMDA
QUIT
Begin DoDot:1
+5 ;DON'T CHECK REVERSALS ALREADY POSTED
IF $PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,2)="P"
QUIT
+6 ;Q:$D(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,4,"B",44)) ;DON'T PROCESS USER STATUS OVERRIDE BAR*1.8*6 SCR120
+7 ;MRS:BAR*1.8*10 D159-1 AND 2
IF $$OVERIDE^BAREDEP1(CLMDA)
QUIT
+8 ;;;S REVERSAL=+$$GET1^DIQ(90056.0205,CLMDA_","_IMPDA_",",.11)=22 old code HEAT148388 - BAR 1.8*24
+9 ; 1/10/2014 P.OTT HEAT148388 - BAR 1.8*24
SET REVERSAL=$$ISREV(CLMDA,IMPDA)
+10 ;ONLY REVERSALS WITH A NEGATIVE AMOUNT WILL BE PROCESSED FOR A MATCHING PAYMENT - PER ADRIAN
+11 IF REVERSAL
Begin DoDot:2
+12 IF $GET(BARDBG)
WRITE !,"SHOULD WE CHECK FOR A MATCHING PAYMENT? ",$$GET1^DIQ(90056.0205,CLMDA_","_IMPDA_",",.01)
+13 IF $GET(BARDBG)
WRITE !,"ONLY IF E-PAYMENT IS < 0 ",$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,4)
End DoDot:2
+14 ;old code I REVERSAL,$$IHS^BARUFUT(DUZ(2)),(+$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,4)<0) D REVCHECK(IMPDA,CLMDA) ;CHECK FOR PAYMENT AND REVERSALS W/IN ERA FILE
+15 ;HEAT147572 - BAR 1.8*24
IF REVERSAL
IF $$IHSNEGB^BARUFUT(DUZ(2))
IF (+$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,4)<0)
DO REVCHECK(IMPDA,CLMDA)
End DoDot:1
+16 QUIT
REVCHECK(IMPDA,REVDA) ;EP - REVERSAL AND PAYMENT CHECKS
+1 IF $GET(BARDBG)
WRITE !!,"LOOKING FOR MATCHING PAYMENT FOR REVERSAL ",$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,REVDA,0)),U)
+2 IF $PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,REVDA,0)),U,2)="P"
IF $GET(BARDBG)
WRITE !,"CLAIM ",$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,REVDA,0)),U)," ALREADY POSTED"
+3 IF $PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,REVDA,5)),U)=139
IF $GET(BARDBG)
WRITE !,"CLAIM ",$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,REVDA,0)),U)," ALREADY CREDIT FROM"
+4 IF $PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,REVDA,5)),U)=138
IF $GET(BARDBG)
WRITE !,"CLAIM ",$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,REVDA,0)),U)," ALREADY CREDIT TO"
+5 IF $PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,REVDA,1)),U)=""
IF $GET(BARDBG)
WRITE !,"CLAIM ",$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,REVDA,0)),U)," NO A-CLAIM"
+6 ;N MATCHES,ERRORS BAR*1.8*6 MOVE UP TO REVLOOP
+7 SET (MATCHES,NOMATCH)=0
+8 DO INBILL(IMPDA,REVDA,.MATCHES,.NOMATCH)
+9 IF $GET(MATCHES)=1
QUIT
+10 SET (MATCHES,NOMATCH)=0
+11 ;NOW CHECK INSIDE ERA FILE FOR MATHES
DO INERA(IMPDA,REVDA,.MATCHES,.NOMATCH)
+12 ; IF MATCH FOUND IN ERA FILE THEN YOU'RE DONE
IF $GET(MATCHES)=1
QUIT
+13 SET (MATCHES,NOMATCH)=0
+14 DO INRPMS(IMPDA,REVDA,.MATCHES,.NOMATCH)
+15 IF $GET(MATCHES)=0
Begin DoDot:1
+16 IF $GET(BARDBG)
WRITE !!,"MATCHING PAYMENT NOT FOUND FOR REVERSAL!"
+17 SET ERRORS("PT NF E")=""
+18 DO ADDREAS^BAREDP04(IMPDA,REVDA,.ERRORS)
+19 KILL ERRORS
End DoDot:1
+20 QUIT
INBILL(IMPDA,REVDA,MATCHES,NOMATCH) ;EP - SEARCH FOR MATCHES WITHIN BILL
+1 NEW CLIENS,CLBILL,CLPAYMNT,CLSTATUS,CLCHECK,PAYMENTS,REVICN,CLMICN,CNT
+2 ;BAR*1.8*6
NEW CLMDA
+3 ;CHECK/EFT TRACE
SET REVCHECK=$$GET1^DIQ(90056.0205,REVDA_","_IMPDA_",",201,"E")
+4 ;E-CLAIM (AR BILL
SET REVBILL=$$GET1^DIQ(90056.0205,REVDA_","_IMPDA_",",.01,"E")
+5 ;E-PAYMENT
SET REVAMT=-$$GET1^DIQ(90056.0205,REVDA_","_IMPDA_",",.04,"E")
+6 ;S REVAMT=-$$GET1^DIQ(90056.0205,REVDA_","_IMPDA_",",.05,"E") ;E-BILLED
+7 ;PAYER CLAIM CONTROL # (ICN)
SET REVICN=$$GET1^DIQ(90056.0205,REVDA_","_IMPDA_",",302,"E")
+8 ;IF REVICN CONTAINS AN 'R' THIS IS A MEDICARE REVERSAL
+9 IF $GET(BARDBG)
WRITE !!,"LOOKING FOR MATCHING PAYMENT FOR ",-REVAMT," WITHIN BILL ",REVBILL
+10 SET PAYMENTS=0
+11 SET CLMDA=""
+12 FOR CNT=1:1
SET CLMDA=$ORDER(^BAREDI("I",DUZ(2),IMPDA,30,"B",REVBILL,CLMDA))
IF CLMDA=""
QUIT
Begin DoDot:1
+13 IF '(CNT#1000)
WRITE "."
+14 ;DON'T CHECK POSTED CLAIMS
IF $PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,2)="P"
QUIT
+15 ;DO NOT PROCESS REVERSAL CLAIM WE FOUND IN BAREDP04
IF REVDA=CLMDA
QUIT
+16 SET CLIENS=CLMDA_","_IMPDA_","
+17 ;Q:$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,1)),U)="" ;IF NOT MATCHED DON'T COMPARE ;bar*1.8*20 REQ4
+18 ;E-CLAIM STATUS CODE (CLP02)
SET CLSTATUS=$PIECE($$GET1^DIQ(90056.0205,CLIENS,.11,"E")," ")
+19 ;MRS:BAR*1.8*10 H2555
IF CLSTATUS=""
SET CLSTATUS=$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,2)),U,4)
+20 ;DON'T LOOK AT OTHER REVERSALS
IF CLSTATUS=22
QUIT
+21 ;PRIMARY,SECONDARY,TERTIARY AS WELL AS THOSE 19,20,21 FORWARDED TO ADDITIONAL PAYER
IF (U_"1"_U_"2"_U_"3"_U_"19"_U_"20"_U_"21"_U)'[(U_CLSTATUS_U)
QUIT
+22 ;POST THIS CLAIM AS TYPE
SET POSTAS=$$GET1^DIQ(90056.0205,CLIENS,501,"I")
+23 ;DON'T TRY TO MATCH A REVERSAL TO A PAYMENT ALREADY MATCHED
IF POSTAS=138!(POSTAS=139)
QUIT
+24 ;PAYER CLAIM CONTROL # (ICN)
SET CLMICN=$$GET1^DIQ(90056.0205,CLIENS,302,"E")
+25 SET PAYMENTS=PAYMENTS+1
+26 ;E-PAYMENT
SET CLPAYMNT=$$GET1^DIQ(90056.0205,CLIENS,.04,"E")
+27 IF REVICN["R"
Begin DoDot:2
+28 IF (CLPAYMNT=REVAMT)
Begin DoDot:3
+29 SET MATCHES=MATCHES+1
+30 SET MATCHES(IMPDA,CLMDA,REVDA)=""
End DoDot:3
+31 IF '$TEST
SET NOMATCH=NOMATCH+1
SET NOMATCH(IMPDA,CLMDA,REVDA)=""
End DoDot:2
QUIT
+32 IF REVAMT=CLPAYMNT
Begin DoDot:2
+33 SET MATCHES=MATCHES+1
+34 SET MATCHES(IMPDA,CLMDA,REVDA)=""
End DoDot:2
+35 IF '$TEST
SET NOMATCH=NOMATCH+1
SET NOMATCH(IMPDA,CLMDA,REVDA)=""
End DoDot:1
+36 IF 'PAYMENTS!'MATCHES
QUIT
+37 IF REVICN["R"
DO MCRERRS(.MATCHES,.NOMATCH,PAYMENTS,"INBILL")
IF 1
+38 IF '$TEST
DO REGERRS(.MATCHES,.NOMATCH,PAYMENTS,"INBILL")
+39 KILL ERRORS
+40 QUIT
INERA(IMPDA,REVDA,MATCHES,NOMATCH) ;EP - FIND PAYMENTS AND REVERSAL W/IN ERA FILE
+1 NEW CLIENS,CLBILL,CLPAYMNT,CLSTATUS,CLCHECK,PAYMENTS,REVICN,CLMICN,CNT
+2 ;BAR*1.8*6
NEW CLMDA
+3 ;CHECK/EFT TRACE
SET REVCHECK=$$GET1^DIQ(90056.0205,REVDA_","_IMPDA_",",201,"E")
+4 ;E-CLAIM (AR BILL
SET REVBILL=$$GET1^DIQ(90056.0205,REVDA_","_IMPDA_",",.01,"E")
+5 ;E-PAYMENT
SET REVAMT=-$$GET1^DIQ(90056.0205,REVDA_","_IMPDA_",",.04,"E")
+6 ;PAYER CLAIM CONTROL # (ICN)
SET REVICN=$$GET1^DIQ(90056.0205,REVDA_","_IMPDA_",",302,"E")
+7 ;CHECK/EFT TRACE
SET ERAFILE=$$GET1^DIQ(90056.02,IMPDA_",",.01,"E")
+8 ;IF REVICN CONTAINS AN 'R' THIS IS A MEDICARE REVERSAL
+9 IF $GET(BARDBG)
WRITE !!,"LOOKING FOR MATCHING PAYMENT FOR ",-REVAMT," IN ERA FILE ",ERAFILE
+10 SET PAYMENTS=0
+11 SET NOMATCH=0
+12 SET CLMDA=0
+13 FOR CNT=1:1
SET CLMDA=$ORDER(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA))
IF 'CLMDA!(MATCHES)
QUIT
Begin DoDot:1
+14 IF '(CNT#1000)
WRITE "."
+15 ;DON'T CHECK POSTED CLAIMS
IF $PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,2)="P"
QUIT
+16 ;CHECK/EFT TRACE
SET CLCHECK=$$GET1^DIQ(90056.0205,CLMDA_","_IMPDA_",",201,"E")
+17 IF CLCHECK'=REVCHECK
QUIT
+18 ;DO NOT PROCESS REVERSAL CLAIM WE FOUND
IF REVDA=CLMDA
QUIT
+19 SET CLIENS=CLMDA_","_IMPDA_","
+20 ;IF NOT MATCHED DON'T COMPARE
IF $PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,1)),U)=""
QUIT
+21 ;E-CLAIM STATUS CODE (CLP02)
SET CLSTATUS=$PIECE($$GET1^DIQ(90056.0205,CLIENS,.11,"E")," ")
+22 ;MRS:BAR*1.8*10 H2555
IF CLSTATUS=""
SET CLSTATUS=$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,2)),U,4)
+23 ;DON'T LOOK AT OTHER REVERSALS,SHOULD WE SKIP ANY OTHERS?
IF CLSTATUS=22
QUIT
+24 ;PRIMARY,SECONDARY,TERTIARY AS WELL AS THOSE 19,20,21 FORWARDED TO ADDITIONAL PAYER
IF (U_"1"_U_"2"_U_"3"_U_"19"_U_"20"_U_"21"_U)'[(U_CLSTATUS_U)
QUIT
+25 ;POST THIS CLAIM AS TYPE
SET POSTAS=$$GET1^DIQ(90056.0205,CLIENS,501,"I")
+26 ;DON'T TRY TO MATCH A REVERSAL TO A PAYMENT ALREADY MATCHED
IF POSTAS=138!(POSTAS=139)
QUIT
+27 SET PAYMENTS=PAYMENTS+1
+28 IF $GET(BARDBG)
WRITE !?15,"SEARCHING FOR PAYMENT TO MATCH REV OF ",REVAMT
+29 ;E-CLAIM (AR BILL
SET CLBILL=$$GET1^DIQ(90056.0205,CLIENS,.01,"E")
+30 ;ALREADY CHECKED WITHIN THE BILL FOR MATCHES, NOW CHECK OTHER BILLS IN ERA FILE
IF CLBILL=REVBILL
QUIT
+31 IF $GET(BARDBG)
WRITE !?20,"REV BILL ",REVBILL,!?20,"CL BILL ",CLBILL
+32 ;PAYER CLAIM CONMTROL # (ICN)
SET CLMICN=$$GET1^DIQ(90056.0205,CLIENS,302,"E")
+33 ;E-PAYMENT
SET CLPAYMNT=$$GET1^DIQ(90056.0205,CLIENS,.04,"E")
+34 ;S CLPAYMNT=$$GET1^DIQ(90056.0205,CLIENS,.05,"E") ;E-BILL
+35 ;MEDICARE MATCH?
+36 IF REVICN["R"
Begin DoDot:2
+37 IF CLMICN=$TRANSLATE(REVICN,"R")
Begin DoDot:3
+38 SET MATCHES=MATCHES+1
+39 SET MATCHES(IMPDA,CLMDA,REVDA)=""
End DoDot:3
+40 IF '$TEST
SET NOMATCH=NOMATCH+1
SET NOMATCH(IMPDA,CLMDA,REVDA)=""
End DoDot:2
QUIT
+41 ;REGULAR MATCH?
+42 IF CLPAYMNT=REVAMT
Begin DoDot:2
+43 SET MATCHES=MATCHES+1
+44 SET MATCHES(IMPDA,CLMDA,REVDA)=""
End DoDot:2
QUIT
+45 IF '$TEST
SET NOMATCH=NOMATCH+1
SET NOMATCH(IMPDA,CLMDA,REVDA)=""
End DoDot:1
+46 IF 'MATCHES!'PAYMENTS
QUIT
+47 IF REVICN["R"
DO MCRERRS(.MCRMATCH,.MCRNOMAT,PAYMENTS,"INERA")
IF 1
+48 IF '$TEST
DO REGERRS(.MATCHES,.NOMATCH,PAYMENTS,"INERA")
+49 KILL ERRORS
+50 QUIT
INRPMS(IMPDA,REVDA,MATCHES,NOMATCH) ;EP - LOOK FOR MATCHING PAYMENT IN A/R BILL
+1 NEW REVAMT,REVBILL,ERACHECK,BARBLIEN,FOUND,REVDATE,COLDA,ITEMDA,REVSCHED,REVERSAL,TAMOUNT
+2 NEW TRANS,BARFROM,BARTO,BARTYPE
+3 ;BAR*1.8*6
NEW CLMDA
+4 IF $GET(BARDBG)
WRITE !!,"LOOKING FOR MATCHING PAYMENT IN RPMS"
+5 ;E-CLAIM PAYMENT
SET REVAMT=$$GET1^DIQ(90056.0205,REVDA_","_IMPDA_",",.04,"E")
+6 ;E-CLAIM
SET REVBILL=$$GET1^DIQ(90056.0205,REVDA_","_IMPDA_",",.01,"E")
+7 ;CHECK/EFT TRACE
SET REVCHECK=$$GET1^DIQ(90056.0205,REVDA_","_IMPDA_",",201,"E")
+8 ;POST THIS CLAIM AS TYPE
SET POSTAS=$$GET1^DIQ(90056.0205,REVDA_","_IMPDA_",",501,"I")
+9 IF POSTAS=138!(POSTAS=139)
QUIT
+10 SET CLMDA=0
SET BILLCHOS=""
+11 FOR
SET CLMDA=$ORDER(^BAREDI("I",DUZ(2),IMPDA,30,"B",BARBILL,CLMDA))
IF 'CLMDA!(BILLCHOS'="")
QUIT
Begin DoDot:1
+12 ;A-CLAIM ; IF THIS IS POPULATED THEN THE CORRECT BILL WAS FOUND OR CHOSEN ALREADY
SET BILLCHOS=$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,1)),U)
End DoDot:1
+13 IF BILLCHOS
SET BARBLIEN=BILLCHOS
+14 IF '$TEST
SET BARBLIEN=$$GETIEN^BAREDEB("B",BARBILL)
+15 IF BARBLIEN="BILL NOT FOUND"
Begin DoDot:1
+16 SET CLMDA=$ORDER(^BAREDI("I",DUZ(2),IMPDA,30,"B",BARBILL,""))
+17 IF '$DATA(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,4,"B",11))
Begin DoDot:2
+18 ;BILL NOT FOUND IN RPMS. SET ONLY IF OLD ERROR 11 NOT SET
SET ERRORS("BL NF")=""
End DoDot:2
+19 DO ADDREAS^BAREDP04(IMPDA,REVDA,.ERRORS)
+20 KILL ERRORS
End DoDot:1
QUIT
+21 IF BARBLIEN="DUPLICATE BILLS FOUND"
Begin DoDot:1
+22 ;DUPLICATE BILLS FOUND IN RPMS
SET ERRORS("DUPB")=""
+23 DO ADDREAS^BAREDP04(IMPDA,REVDA,.ERRORS)
+24 KILL ERRORS
End DoDot:1
QUIT
+25 IF 'BARBLIEN
QUIT 0
+26 SET FOUND=0
+27 ;NUMBER OF REVERSALS ALREADY SET UP FOR THIS AMOUNT.
SET REVERSAL=0
+28 SET TRANS=""
+29 ;REVERSAL CAN NOT APPLY TO A FUTURE PAYMENT
FOR
SET TRANS=$ORDER(^BARTR(DUZ(2),"AC",BARBLIEN,TRANS),-1)
IF 'TRANS!(FOUND)
QUIT
Begin DoDot:1
+30 SET TRANTYPE=$$GET1^DIQ(90050.03,TRANS_",",101,"E")
+31 ;OLD WILL BILL 'PAYMENT', NEW STUFF WILL BE 'PAYMENT CREDIT'
IF TRANTYPE'="PAYMENT"&(TRANTYPE'="PAYMENT CREDIT")
QUIT
+32 SET TAMOUNT=$$GET1^DIQ(90050.03,TRANS_",",3.5,"E")
+33 ;#110 = DATE OF TRANSACTION REVERSED
IF TAMOUNT=REVAMT
IF $$GET1^DIQ(90050.03,TRANS_",",110,"I")
SET REVERSAL=REVERSAL+1
QUIT
+34 IF TAMOUNT=-REVAMT
Begin DoDot:2
+35 SET COLDA=$$GET1^DIQ(90050.03,TRANS_",",14,"I")
+36 SET ITEMDA=$$GET1^DIQ(90050.03,TRANS_",",15,"I")
+37 ;;;Q:'$D(^BARCOL(DUZ(2),"D",REVCHECK,COLDA,ITEMDA)) ;IF COLLECTION BATCH AND ITEM DON'T MATCH UP WE CAN'T POST
+38 ;- BAR 1.8*23
IF '$DATA(^BARCOL(DUZ(2),"D",REVCHECK,COLDA,ITEMDA))
IF '$DATA(^BARCOL(DUZ(2),"D",+REVCHECK,COLDA,ITEMDA))
QUIT
+39 ;MATCHING REVERSAL SO THIS PAYMENT MATCHES
IF REVERSAL
SET REVERSAL=REVERSAL-1
QUIT
+40 SET FOUND=FOUND+1
+41 SET REVDATE=$$GET1^DIQ(90050.03,TRANS_",",.01,"I")
+42 SET REVSCHED=$$GET1^DIQ(90051.01,COLDA_",",28,"I")
+43 IF REVSCHED=""
SET REVSCHED=$$GET1^DIQ(90051.1101,ITEMDA_","_COLDA_",",20,"I")
+44 IF REVSCHED=""
SET REVSCHED="PRE-UFMS_COLLECTIONS"
End DoDot:2
End DoDot:1
+45 IF 'FOUND
Begin DoDot:1
+46 ;MATCHING PAYMENT NOT FOUND IN A/R TRANSACTION FILE
SET ERRORS("PR NM R")=""
+47 DO ADDREAS^BAREDP04(IMPDA,REVDA,.ERRORS)
+48 KILL ERRORS
End DoDot:1
QUIT
+49 ;NOW WE SHOULD HAVE A NON-MATCHED PAYMENT EQUALING OUR ERA REVERSAL
+50 KILL DIE,DIC,DR,DA,DIR
+51 SET BARFROM=$$GET1^DIQ(90056.0205,REVDA_","_IMPDA_",",1.01,"I")
+52 SET BARTO=$GET(BARBLIEN)
+53 ;DON'T MATCH TO A NON-MATCHED CLAIM
IF BARFROM=""
QUIT
+54 SET DIE=$$DIC^XBDIQ1(90056.0205)
+55 SET BARTYPE=139
+56 ;S DR=DR=DR_"501///^S X=BARTYPE" ;CREDIT TO OTHER BILL
+57 ;CREDIT TO OTHER BILL BAR*1.8*6 IM29724
SET DR="501///^S X=BARTYPE"
+58 SET DR=DR_";.12///^S X=REVDATE"
+59 SET DR=DR_";301///^S X=REVSCHED"
+60 SET DR=DR_";602///^S X=BARFROM"
+61 SET DR=DR_";601///^S X=BARTO"
+62 SET DA(1)=IMPDA
+63 SET DA=REVDA
+64 DO ^DIE
+65 ;HAD TROUBLE GETTING THE DIE CALL TO WORK FOR .12 AND 301
+66 SET $PIECE(^BAREDI("I",DUZ(2),DA(1),30,DA,0),U,12)=REVDATE
+67 SET $PIECE(^BAREDI("I",DUZ(2),DA(1),30,DA,3),U)=REVSCHED
+68 KILL DR,DIE,DIC,DIR
+69 KILL ERRORS
+70 QUIT
MCRERRS(MATCHES,NOMATCH,PAYMENTS,WHERE) ;EP - MCR ERRORS
+1 NEW ERRORS,CLMDA
+2 IF MATCHES=1
DO SETMATCH(.MATCHES)
QUIT
+3 IF PAYMENTS=0
Begin DoDot:1
+4 IF WHERE="INBILL"
SET ERRORS("PT NF B")=""
+5 IF '$TEST
SET ERRORS("PT NF E")=""
+6 DO ADDREAS^BAREDP04(IMPDA,REVDA,.ERRORS)
End DoDot:1
+7 IF MATCHES>0
Begin DoDot:1
+8 IF WHERE="INBILL"
SET ERRORS("MP MCR B")=""
+9 IF '$TEST
SET ERRORS("MP MCR E")=""
+10 DO ADDREAS^BAREDP04(IMPDA,REVDA,.ERRORS)
+11 SET CLMDA=""
+12 FOR
SET CLMDA=$ORDER(MATCHES(IMPDA,CLMDA))
IF 'CLMDA
QUIT
Begin DoDot:2
+13 DO ADDREAS^BAREDP04(IMPDA,CLMDA,.ERRORS)
End DoDot:2
End DoDot:1
+14 IF NOMATCH>0
Begin DoDot:1
+15 IF WHERE="INBILL"
SET ERRORS("NM MCR B")=""
+16 IF '$TEST
SET ERRORS("NM MCR E")=""
+17 DO ADDREAS^BAREDP04(IMPDA,REVDA,.ERRORS)
+18 SET CLMDA=""
+19 FOR
SET CLMDA=$ORDER(NOMATCH(IMPDA,CLMDA))
IF 'CLMDA
QUIT
Begin DoDot:2
+20 DO ADDREAS^BAREDP04(IMPDA,CLMDA,.ERRORS)
End DoDot:2
End DoDot:1
+21 KILL ERRORS
+22 QUIT
REGERRS(MATCHES,NOMATCH,PAYMENTS,WHERE) ; EP
+1 NEW ERRORS,CLMDA
+2 IF MATCHES=1
DO SETMATCH(.MATCHES)
QUIT
+3 IF PAYMENTS=0
Begin DoDot:1
+4 IF WHERE="INBILL"
SET ERRORS("PT NF B")=""
+5 IF '$TEST
SET ERRORS("PT NF E")=""
+6 DO ADDREAS^BAREDP04(IMPDA,REVDA,.ERRORS)
End DoDot:1
+7 IF MATCHES>1
Begin DoDot:1
+8 IF WHERE="INBILL"
SET ERRORS("MPB")=""
+9 IF '$TEST
SET ERRORS("MPE")=""
+10 DO ADDREAS^BAREDP04(IMPDA,REVDA,.ERRORS)
+11 SET CLMDA=""
+12 FOR
SET CLMDA=$ORDER(MATCHES(IMPDA,CLMDA))
IF 'CLMDA
QUIT
Begin DoDot:2
+13 DO ADDREAS^BAREDP04(IMPDA,CLMDA,.ERRORS)
End DoDot:2
End DoDot:1
+14 IF NOMATCH>0
Begin DoDot:1
+15 IF WHERE="INBILL"
SET ERRORS("PR NM B")=""
+16 IF '$TEST
SET ERRORS("PR NM E")=""
+17 DO ADDREAS^BAREDP04(IMPDA,REVDA,.ERRORS)
+18 SET CLMDA=""
+19 FOR
SET CLMDA=$ORDER(NOMATCH(IMPDA,CLMDA))
IF 'CLMDA
QUIT
Begin DoDot:2
+20 DO ADDREAS^BAREDP04(IMPDA,CLMDA,.ERRORS)
End DoDot:2
End DoDot:1
+21 KILL ERRORS
+22 QUIT
SETMATCH(MATCH) ;EP - SET TO MATCHING AND SET TRANSACTION TYPE
+1 NEW IMPDA,CLMDA,REVDA,CLIENS,REVIENS,BARFROM,BARTO,CNT
+2 SET IMPDA=$ORDER(MATCH(""))
+3 IF IMPDA=""
QUIT
+4 SET CLMDA=$ORDER(MATCH(IMPDA,""))
+5 IF CLMDA=""
QUIT
+6 SET REVDA=$ORDER(MATCH(IMPDA,CLMDA,""))
+7 IF REVDA=""
QUIT
+8 SET CLIENS=CLMDA_","_IMPDA_","
+9 SET REVIENS=REVDA_","_IMPDA_","
+10 IF $ORDER(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,4,0))
QUIT
+11 IF $ORDER(^BAREDI("I",DUZ(2),IMPDA,30,REVDA,4,0))
QUIT
+12 IF $GET(BARDBG)
WRITE !!,"PAYMENT REVERSAL: ",$$GET1^DIQ(90056.0205,CLIENS,.01,"E")
+13 IF $GET(BARDBG)
WRITE !,"MATCHED TO REVERSAL: ",$$GET1^DIQ(90056.0205,REVIENS,.01,"E")
+14 SET BARFROM=$$GET1^DIQ(90056.0205,REVIENS,1.01,"I")
+15 SET BARTO=$$GET1^DIQ(90056.0205,CLIENS,1.01,"I")
+16 ;DO NOT MATCH TO A NON-MATCHED CLAIM
IF BARFROM=""!(BARTO="")
QUIT
+17 IF $GET(BARDBG)
WRITE !,"PAYMENT CREDIT APPLIED FROM: ",BARFROM
+18 IF $GET(BARDBG)
WRITE !,"PAYMENT CREDIT APPLIED TO: ",BARTO
+19 KILL DA
SET CNT=0
+20 FOR DA=CLMDA,REVDA
Begin DoDot:1
+21 SET CNT=CNT+1
+22 KILL DR,DIE,DIC,DIR
+23 SET DIE=$$DIC^XBDIQ1(90056.0205)
+24 ;CREDIT FROM OTHER BILL
IF CNT=1
SET TYPE=139
+25 ;CREDIT TO OTHER BILL
IF '$TEST
SET TYPE=138
+26 SET STAT="M"
+27 SET DR=".02///^S X=STAT"
+28 SET DR=DR_";501///^S X=TYPE"
+29 IF CNT=1
SET DR=DR_";602///^S X=BARFROM"
+30 IF '$TEST
SET DR=DR_";601///^S X=BARTO"
+31 SET DA(1)=IMPDA
+32 DO ^DIE
+33 KILL DR,DIE,DIC,DIR
End DoDot:1
+34 QUIT
ISREV(CLMDA,IMPDA) ;HEAT148388- BAR 1.8*24
+1 IF +$$GET1^DIQ(90056.0205,CLMDA_","_IMPDA_",",.11)=22
QUIT 1
+2 QUIT 0
+3 ;----------------
