Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BAR50EP

BAR50EP.m

Go to the documentation of this file. 
  1. BAR50EP ; IHS/SD/TPF - AR ERA PAYMENT CHECKER ; 01/30/2009
  1.  ;;1.8;IHS ACCOUNTS RECEIVABLE;**5,6,10,20,21,23,24**;OCT 26,2005;Build 69
  1.  ;BAR*1.8*6 IHS/SD/TPF MOVE REVERSAL CHECK TO A FULL CLMDA LOOP
  1.  ;IHS/SD/POT HEAT82698 NOV 2012  ACCEPT LEADING ZEROES IN CHKECK # (POS)- BAR 1.8*23
  1.  ;IHS/SD/POT HEAT148388 1/10/2014 ACCEPT REVERSALS FOR TYPE= 1 IF NEG PAYMENT- BAR 1.8*24
  1.  ;IHS/SD/POT HEAT147572 ALLOW TRIBAL SITES ERA POSTING OF NEG BAL & CANCELLED BILLS- BAR 1.8*24
  1. REVLOOP(IMPDA) ;EP - REVERSAL LOOP
  1.  N CLMDA,MATCHES,ERRORS
  1.  S CLMDA=0
  1.  I $G(BARDBG) W !!,"BEGIN REVERSAL/PAYMENT MATCHING PROCESS"
  1.  F  S CLMDA=$O(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA)) Q:'CLMDA  D
  1.  . Q:$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,2)="P"  ;DON'T CHECK REVERSALS ALREADY POSTED
  1.  . ;Q:$D(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,4,"B",44))  ;DON'T PROCESS USER STATUS OVERRIDE BAR*1.8*6 SCR120
  1.  . Q:$$OVERIDE^BAR50EP1(CLMDA)                         ;MRS:BAR*1.8*10 D159-1 AND 2
  1.  . ;;;S REVERSAL=+$$GET1^DIQ(90056.0205,CLMDA_","_IMPDA_",",.11)=22 old code HEAT148388
  1.  . S REVERSAL=$$ISREV(CLMDA,IMPDA) ; 1/10/2014 P.OTT HEAT148388 BAR 1.8*24
  1.  . ;ONLY REVERSALS WITH A NEGATIVE AMOUNT WILL BE PROCESSED FOR A MATCHING PAYMENT - PER ADRIAN
  1.  . I REVERSAL D
  1.  .. I $G(BARDBG) W !,"SHOULD WE CHECK FOR A MATCHING PAYMENT?  ",$$GET1^DIQ(90056.0205,CLMDA_","_IMPDA_",",.01)
  1.  .. I $G(BARDBG) W !,"ONLY IF E-PAYMENT IS < 0 ",$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,4)
  1.  . ;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
  1.  . 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
  1.  Q
  1. REVCHECK(IMPDA,REVDA) ;EP - REVERSAL AND PAYMENT CHECKS
  1.  I $G(BARDBG) W !!,"LOOKING FOR MATCHING PAYMENT FOR REVERSAL ",$P($G(^BAREDI("I",DUZ(2),IMPDA,30,REVDA,0)),U)
  1.  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"
  1.  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"
  1.  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"
  1.  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"
  1.  ;N MATCHES,ERRORS BAR*1.8*6 MOVE UP TO REVLOOP
  1.  S (MATCHES,NOMATCH)=0
  1.  D INBILL(IMPDA,REVDA,.MATCHES,.NOMATCH)
  1.  Q:$G(MATCHES)=1
  1.  S (MATCHES,NOMATCH)=0
  1.  D INERA(IMPDA,REVDA,.MATCHES,.NOMATCH)   ;NOW CHECK INSIDE ERA FILE FOR MATHES
  1.  Q:$G(MATCHES)=1    ; IF MATCH FOUND IN ERA FILE THEN YOU'RE DONE
  1.  S (MATCHES,NOMATCH)=0
  1.  D INRPMS(IMPDA,REVDA,.MATCHES,.NOMATCH)
  1.  I $G(MATCHES)=0 D
  1.  .I $G(BARDBG) W !!,"MATCHING PAYMENT NOT FOUND FOR REVERSAL!"
  1.  .S ERRORS("PT NF E")=""
  1.  .D ADDREAS^BAR50P04(IMPDA,REVDA,.ERRORS)
  1.  .K ERRORS
  1.  Q
  1. INBILL(IMPDA,REVDA,MATCHES,NOMATCH) ;EP - SEARCH FOR MATCHES WITHIN BILL
  1.  N CLIENS,CLBILL,CLPAYMNT,CLSTATUS,CLCHECK,PAYMENTS,REVICN,CLMICN,CNT
  1.  N CLMDA  ;BAR*1.8*6
  1.  S REVCHECK=$$GET1^DIQ(90056.0205,REVDA_","_IMPDA_",",201,"E")   ;CHECK/EFT TRACE
  1.  S REVBILL=$$GET1^DIQ(90056.0205,REVDA_","_IMPDA_",",.01,"E")   ;E-CLAIM (AR BILL
  1.  S REVAMT=-$$GET1^DIQ(90056.0205,REVDA_","_IMPDA_",",.04,"E")   ;E-PAYMENT
  1.  ;S REVAMT=-$$GET1^DIQ(90056.0205,REVDA_","_IMPDA_",",.05,"E")   ;E-BILLED
  1.  S REVICN=$$GET1^DIQ(90056.0205,REVDA_","_IMPDA_",",302,"E")   ;PAYER CLAIM CONTROL # (ICN)
  1.  ;IF REVICN CONTAINS AN 'R' THIS IS A MEDICARE REVERSAL
  1.  I $G(BARDBG) W !!,"LOOKING FOR MATCHING PAYMENT FOR ",-REVAMT," WITHIN BILL ",REVBILL
  1.  S PAYMENTS=0
  1.  S CLMDA=""
  1.  F CNT=1:1 S CLMDA=$O(^BAREDI("I",DUZ(2),IMPDA,30,"B",REVBILL,CLMDA)) Q:CLMDA=""  D
  1.  .W:'(CNT#1000) "."
  1.  .Q:$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,2)="P"  ;DON'T CHECK POSTED CLAIMS
  1.  .Q:REVDA=CLMDA  ;DO NOT PROCESS REVERSAL CLAIM WE FOUND IN BAR50P04
  1.  .S CLIENS=CLMDA_","_IMPDA_","
  1.  .;Q:$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,1)),U)=""  ;IF NOT MATCHED DON'T COMPARE  ;bar*1.8*20 REQ4
  1.  .S CLSTATUS=$P($$GET1^DIQ(90056.0205,CLIENS,.11,"E")," ")  ;E-CLAIM STATUS CODE (CLP02)
  1.  .I CLSTATUS="" S CLSTATUS=$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,2)),U,4)  ;MRS:BAR*1.8*10 H2555
  1.  . ;;;OLD CODE I CLSTATUS=22 Q  ;DON'T LOOK AT OTHER REVERSALS
  1.  . I $$ISREV(CLMDA,IMPDA) Q  ;new code
  1.  .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
  1.  . ;????
  1.  .S POSTAS=$$GET1^DIQ(90056.0205,CLIENS,501,"I")   ;POST THIS CLAIM AS TYPE
  1.  .Q:POSTAS=138!(POSTAS=139)  ;DON'T TRY TO MATCH A REVERSAL TO A PAYMENT ALREADY MATCHED
  1.  .S CLMICN=$$GET1^DIQ(90056.0205,CLIENS,302,"E")   ;PAYER CLAIM CONTROL # (ICN)
  1.  .S PAYMENTS=PAYMENTS+1
  1.  .S CLPAYMNT=$$GET1^DIQ(90056.0205,CLIENS,.04,"E")  ;E-PAYMENT
  1.  .I REVICN["R" D  Q
  1.  ..I (CLPAYMNT=REVAMT) D
  1.  ...S MATCHES=MATCHES+1
  1.  ...S MATCHES(IMPDA,CLMDA,REVDA)=""
  1.  ..E  S NOMATCH=NOMATCH+1 S NOMATCH(IMPDA,CLMDA,REVDA)=""
  1.  .I REVAMT=CLPAYMNT D
  1.  ..S MATCHES=MATCHES+1
  1.  ..S MATCHES(IMPDA,CLMDA,REVDA)=""
  1.  .E  S NOMATCH=NOMATCH+1 S NOMATCH(IMPDA,CLMDA,REVDA)=""
  1.  Q:'PAYMENTS!'MATCHES
  1.  I REVICN["R" D MCRERRS(.MATCHES,.NOMATCH,PAYMENTS,"INBILL") I 1
  1.  E  D REGERRS(.MATCHES,.NOMATCH,PAYMENTS,"INBILL")
  1.  K ERRORS
  1.  Q
  1. INERA(IMPDA,REVDA,MATCHES,NOMATCH) ;EP - FIND PAYMENTS AND REVERSAL W/IN ERA FILE
  1.  N CLIENS,CLBILL,CLPAYMNT,CLSTATUS,CLCHECK,PAYMENTS,REVICN,CLMICN,CNT
  1.  N CLMDA  ;BAR*1.8*6
  1.  S REVCHECK=$$GET1^DIQ(90056.0205,REVDA_","_IMPDA_",",201,"E")  ;CHECK/EFT TRACE
  1.  S REVBILL=$$GET1^DIQ(90056.0205,REVDA_","_IMPDA_",",.01,"E")   ;E-CLAIM (AR BILL
  1.  S REVAMT=-$$GET1^DIQ(90056.0205,REVDA_","_IMPDA_",",.04,"E")   ;E-PAYMENT
  1.  S REVICN=$$GET1^DIQ(90056.0205,REVDA_","_IMPDA_",",302,"E")   ;PAYER CLAIM CONTROL # (ICN)
  1.  S ERAFILE=$$GET1^DIQ(90056.02,IMPDA_",",.01,"E")  ;CHECK/EFT TRACE
  1.  ;IF REVICN CONTAINS AN 'R' THIS IS A MEDICARE REVERSAL
  1.  I $G(BARDBG) W !!,"LOOKING FOR MATCHING PAYMENT FOR ",-REVAMT," IN ERA FILE ",ERAFILE
  1.  S PAYMENTS=0
  1.  S NOMATCH=0
  1.  S CLMDA=0
  1.  F CNT=1:1 S CLMDA=$O(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA)) Q:'CLMDA!(MATCHES)  D
  1.  .W:'(CNT#1000) "."
  1.  .Q:$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,2)="P"  ;DON'T CHECK POSTED CLAIMS
  1.  .S CLCHECK=$$GET1^DIQ(90056.0205,CLMDA_","_IMPDA_",",201,"E")  ;CHECK/EFT TRACE
  1.  .Q:CLCHECK'=REVCHECK
  1.  .Q:REVDA=CLMDA  ;DO NOT PROCESS REVERSAL CLAIM WE FOUND
  1.  .S CLIENS=CLMDA_","_IMPDA_","
  1.  .Q:$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,1)),U)=""  ;IF NOT MATCHED DON'T COMPARE
  1.  .S CLSTATUS=$P($$GET1^DIQ(90056.0205,CLIENS,.11,"E")," ")  ;E-CLAIM STATUS CODE (CLP02)
  1.  .I CLSTATUS="" S CLSTATUS=$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,2)),U,4)  ;MRS:BAR*1.8*10 H2555
  1.  .I CLSTATUS=22 Q  ;DON'T LOOK AT OTHER REVERSALS,SHOULD WE SKIP ANY OTHERS?
  1.  .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
  1.  .S POSTAS=$$GET1^DIQ(90056.0205,CLIENS,501,"I")   ;POST THIS CLAIM AS TYPE
  1.  .Q:POSTAS=138!(POSTAS=139)  ;DON'T TRY TO MATCH A REVERSAL TO A PAYMENT ALREADY MATCHED
  1.  .S PAYMENTS=PAYMENTS+1
  1.  .I $G(BARDBG) W !?15,"SEARCHING FOR PAYMENT TO MATCH REV OF ",REVAMT
  1.  .S CLBILL=$$GET1^DIQ(90056.0205,CLIENS,.01,"E")  ;E-CLAIM (AR BILL
  1.  .Q:CLBILL=REVBILL  ;ALREADY CHECKED WITHIN THE BILL FOR MATCHES, NOW CHECK OTHER BILLS IN ERA FILE
  1.  .I $G(BARDBG) W !?20,"REV BILL ",REVBILL,!?20,"CL BILL ",CLBILL
  1.  .S CLMICN=$$GET1^DIQ(90056.0205,CLIENS,302,"E")   ;PAYER CLAIM CONMTROL # (ICN)
  1.  .S CLPAYMNT=$$GET1^DIQ(90056.0205,CLIENS,.04,"E")  ;E-PAYMENT
  1.  .;S CLPAYMNT=$$GET1^DIQ(90056.0205,CLIENS,.05,"E")  ;E-BILL
  1.  .;MEDICARE MATCH?
  1.  .I REVICN["R" D  Q
  1.  ..I CLMICN=$TR(REVICN,"R") D
  1.  ...S MATCHES=MATCHES+1
  1.  ...S MATCHES(IMPDA,CLMDA,REVDA)=""
  1.  ..E  S NOMATCH=NOMATCH+1 S NOMATCH(IMPDA,CLMDA,REVDA)=""
  1.  .;REGULAR MATCH?
  1.  .I CLPAYMNT=REVAMT D  Q
  1.  ..S MATCHES=MATCHES+1
  1.  ..S MATCHES(IMPDA,CLMDA,REVDA)=""
  1.  .E  S NOMATCH=NOMATCH+1 S NOMATCH(IMPDA,CLMDA,REVDA)=""
  1.  Q:'MATCHES!'PAYMENTS
  1.  I REVICN["R" D MCRERRS(.MCRMATCH,.MCRNOMAT,PAYMENTS,"INERA") I 1
  1.  E  D REGERRS(.MATCHES,.NOMATCH,PAYMENTS,"INERA")
  1.  K ERRORS
  1.  Q
  1. INRPMS(IMPDA,REVDA,MATCHES,NOMATCH) ;EP - LOOK FOR MATCHING PAYMENT IN A/R BILL
  1.  N REVAMT,REVBILL,ERACHECK,BARBLIEN,FOUND,REVDATE,COLDA,ITEMDA,REVSCHED,REVERSAL,TAMOUNT
  1.  N TRANS,BARFROM,BARTO,BARTYPE
  1.  N CLMDA  ;BAR*1.8*6
  1.  I $G(BARDBG) W !!,"LOOKING FOR MATCHING PAYMENT IN RPMS"
  1.  S REVAMT=$$GET1^DIQ(90056.0205,REVDA_","_IMPDA_",",.04,"E")   ;E-CLAIM PAYMENT
  1.  S REVBILL=$$GET1^DIQ(90056.0205,REVDA_","_IMPDA_",",.01,"E")   ;E-CLAIM
  1.  S REVCHECK=$$GET1^DIQ(90056.0205,REVDA_","_IMPDA_",",201,"E")  ;CHECK/EFT TRACE
  1.  S POSTAS=$$GET1^DIQ(90056.0205,REVDA_","_IMPDA_",",501,"I")   ;POST THIS CLAIM AS TYPE
  1.  Q:POSTAS=138!(POSTAS=139)
  1.  S CLMDA=0,BILLCHOS=""
  1.  F  S CLMDA=$O(^BAREDI("I",DUZ(2),IMPDA,30,"B",BARBILL,CLMDA)) Q:'CLMDA!(BILLCHOS'="")  D
  1.  .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
  1.  I BILLCHOS S BARBLIEN=BILLCHOS
  1.  E  S BARBLIEN=$$GETIEN^BAR50EB("B",BARBILL)
  1.  I BARBLIEN="BILL NOT FOUND" D  Q
  1.  .S CLMDA=$O(^BAREDI("I",DUZ(2),IMPDA,30,"B",BARBILL,""))
  1.  .I '$D(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,4,"B",11)) D
  1.  ..S ERRORS("BL NF")=""  ;BILL NOT FOUND IN RPMS. SET ONLY IF OLD ERROR 11 NOT SET
  1.  .D ADDREAS^BAR50P04(IMPDA,REVDA,.ERRORS)
  1.  .K ERRORS
  1.  I BARBLIEN="DUPLICATE BILLS FOUND" D  Q
  1.  .S ERRORS("DUPB")=""  ;DUPLICATE BILLS FOUND IN RPMS
  1.  .D ADDREAS^BAR50P04(IMPDA,REVDA,.ERRORS)
  1.  .K ERRORS
  1.  Q:'BARBLIEN 0
  1.  S FOUND=0
  1.  S REVERSAL=0  ;NUMBER OF REVERSALS ALREADY SET UP FOR THIS AMOUNT.
  1.  S TRANS=""
  1.  F  S TRANS=$O(^BARTR(DUZ(2),"AC",BARBLIEN,TRANS),-1) Q:'TRANS!(FOUND)  D  ;REVERSAL CAN NOT APPLY TO A FUTURE PAYMENT
  1.  .S TRANTYPE=$$GET1^DIQ(90050.03,TRANS_",",101,"E")
  1.  .Q:TRANTYPE'="PAYMENT"&(TRANTYPE'="PAYMENT CREDIT")  ;OLD WILL BILL 'PAYMENT', NEW STUFF WILL BE 'PAYMENT CREDIT'
  1.  .S TAMOUNT=$$GET1^DIQ(90050.03,TRANS_",",3.5,"E")
  1.  .I TAMOUNT=REVAMT,$$GET1^DIQ(90050.03,TRANS_",",110,"I") S REVERSAL=REVERSAL+1 Q  ;#110 = DATE OF TRANSACTION REVERSED
  1.  .I TAMOUNT=-REVAMT D
  1.  ..S COLDA=$$GET1^DIQ(90050.03,TRANS_",",14,"I")
  1.  ..S ITEMDA=$$GET1^DIQ(90050.03,TRANS_",",15,"I")
  1.  ..;;;Q:'$D(^BARCOL(DUZ(2),"D",REVCHECK,COLDA,ITEMDA))  ;IF COLLECTION BATCH AND ITEM DON'T MATCH UP WE CAN'T POST - BAR 1.8*23 OLD CODE
  1.  .. I '$D(^BARCOL(DUZ(2),"D",REVCHECK,COLDA,ITEMDA)),'$D(^BARCOL(DUZ(2),"D",+REVCHECK,COLDA,ITEMDA)) Q  ;- BAR 1.8*23
  1.  ..I REVERSAL S REVERSAL=REVERSAL-1 Q  ;MATCHING REVERSAL SO THIS PAYMENT MATCHES
  1.  ..S FOUND=FOUND+1
  1.  ..S REVDATE=$$GET1^DIQ(90050.03,TRANS_",",.01,"I")
  1.  ..S REVSCHED=$$GET1^DIQ(90051.01,COLDA_",",28,"I")
  1.  ..I REVSCHED="" S REVSCHED=$$GET1^DIQ(90051.1101,ITEMDA_","_COLDA_",",20,"I")
  1.  ..S:REVSCHED="" REVSCHED="PRE-UFMS_COLLECTIONS"
  1.  I 'FOUND D  Q
  1.  .S ERRORS("PR NM R")=""  ;MATCHING PAYMENT NOT FOUND IN A/R TRANSACTION FILE
  1.  .D ADDREAS^BAR50P04(IMPDA,REVDA,.ERRORS)
  1.  .K ERRORS
  1.  ;NOW WE SHOULD HAVE A NON-MATCHED PAYMENT EQUALING OUR ERA REVERSAL
  1.  K DIE,DIC,DR,DA,DIR
  1.  S BARFROM=$$GET1^DIQ(90056.0205,REVDA_","_IMPDA_",",1.01,"I")
  1.  S BARTO=$G(BARBLIEN)
  1.  Q:BARFROM=""  ;DON'T MATCH TO A NON-MATCHED CLAIM
  1.  S DIE=$$DIC^XBDIQ1(90056.0205)
  1.  S BARTYPE=139
  1.  ;S DR=DR=DR_"501///^S X=BARTYPE"  ;CREDIT TO OTHER BILL
  1.  S DR="501///^S X=BARTYPE"  ;CREDIT TO OTHER BILL BAR*1.8*6 IM29724
  1.  S DR=DR_";.12///^S X=REVDATE"
  1.  S DR=DR_";301///^S X=REVSCHED"
  1.  S DR=DR_";602///^S X=BARFROM"
  1.  S DR=DR_";601///^S X=BARTO"
  1.  S DA(1)=IMPDA
  1.  S DA=REVDA
  1.  D ^DIE
  1.  ;HAD TROUBLE GETTING THE DIE CALL TO WORK FOR .12 AND 301
  1.  S $P(^BAREDI("I",DUZ(2),DA(1),30,DA,0),U,12)=REVDATE
  1.  S $P(^BAREDI("I",DUZ(2),DA(1),30,DA,3),U)=REVSCHED
  1.  K DR,DIE,DIC,DIR
  1.  K ERRORS
  1.  Q
  1. MCRERRS(MATCHES,NOMATCH,PAYMENTS,WHERE) ;EP - MCR ERRORS
  1.  N ERRORS,CLMDA
  1.  I MATCHES=1 D SETMATCH(.MATCHES) Q
  1.  I PAYMENTS=0 D
  1.  .I WHERE="INBILL" S ERRORS("PT NF B")=""
  1.  .E  S ERRORS("PT NF E")=""
  1.  .D ADDREAS^BAR50P04(IMPDA,REVDA,.ERRORS)
  1.  I MATCHES>0 D
  1.  .I WHERE="INBILL" S ERRORS("MP MCR B")=""
  1.  .E  S ERRORS("MP MCR E")=""
  1.  .D ADDREAS^BAR50P04(IMPDA,REVDA,.ERRORS)
  1.  .S CLMDA=""
  1.  .F  S CLMDA=$O(MATCHES(IMPDA,CLMDA)) Q:'CLMDA  D
  1.  ..D ADDREAS^BAR50P04(IMPDA,CLMDA,.ERRORS)
  1.  I NOMATCH>0 D
  1.  .I WHERE="INBILL" S ERRORS("NM MCR B")=""
  1.  .E  S ERRORS("NM MCR E")=""
  1.  .D ADDREAS^BAR50P04(IMPDA,REVDA,.ERRORS)
  1.  .S CLMDA=""
  1.  .F  S CLMDA=$O(NOMATCH(IMPDA,CLMDA)) Q:'CLMDA  D
  1.  ..D ADDREAS^BAR50P04(IMPDA,CLMDA,.ERRORS)
  1.  K ERRORS
  1.  Q
  1. REGERRS(MATCHES,NOMATCH,PAYMENTS,WHERE) ; EP 
  1.  N ERRORS,CLMDA
  1.  I MATCHES=1 D SETMATCH(.MATCHES) Q
  1.  I PAYMENTS=0 D
  1.  .I WHERE="INBILL" S ERRORS("PT NF B")=""
  1.  .E  S ERRORS("PT NF E")=""
  1.  .D ADDREAS^BAR50P04(IMPDA,REVDA,.ERRORS)
  1.  I MATCHES>1 D
  1.  .I WHERE="INBILL" S ERRORS("MPB")=""
  1.  .E  S ERRORS("MPE")=""
  1.  .D ADDREAS^BAR50P04(IMPDA,REVDA,.ERRORS)
  1.  .S CLMDA=""
  1.  .F  S CLMDA=$O(MATCHES(IMPDA,CLMDA)) Q:'CLMDA  D
  1.  ..D ADDREAS^BAR50P04(IMPDA,CLMDA,.ERRORS)
  1.  I NOMATCH>0 D
  1.  .I WHERE="INBILL" S ERRORS("PR NM B")=""
  1.  .E  S ERRORS("PR NM E")=""
  1.  .D ADDREAS^BAR50P04(IMPDA,REVDA,.ERRORS)
  1.  .S CLMDA=""
  1.  .F  S CLMDA=$O(NOMATCH(IMPDA,CLMDA)) Q:'CLMDA  D
  1.  ..D ADDREAS^BAR50P04(IMPDA,CLMDA,.ERRORS)
  1.  K ERRORS
  1.  Q
  1. SETMATCH(MATCH) ;EP - SET TO MATCHING AND SET TRANSACTION TYPE
  1.  N IMPDA,CLMDA,REVDA,CLIENS,REVIENS,BARFROM,BARTO,CNT
  1.  S IMPDA=$O(MATCH(""))
  1.  Q:IMPDA=""
  1.  S CLMDA=$O(MATCH(IMPDA,""))
  1.  Q:CLMDA=""
  1.  S REVDA=$O(MATCH(IMPDA,CLMDA,""))
  1.  Q:REVDA=""
  1.  S CLIENS=CLMDA_","_IMPDA_","
  1.  S REVIENS=REVDA_","_IMPDA_","
  1.  I $O(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,4,0)) Q
  1.  I $O(^BAREDI("I",DUZ(2),IMPDA,30,REVDA,4,0)) Q
  1.  I $G(BARDBG) W !!,"PAYMENT REVERSAL: ",$$GET1^DIQ(90056.0205,CLIENS,.01,"E")
  1.  I $G(BARDBG) W !,"MATCHED TO REVERSAL: ",$$GET1^DIQ(90056.0205,REVIENS,.01,"E")
  1.  S BARFROM=$$GET1^DIQ(90056.0205,REVIENS,1.01,"I")
  1.  S BARTO=$$GET1^DIQ(90056.0205,CLIENS,1.01,"I")
  1.  Q:BARFROM=""!(BARTO="")  ;DO NOT MATCH TO A NON-MATCHED CLAIM
  1.  I $G(BARDBG) W !,"PAYMENT CREDIT APPLIED FROM: ",BARFROM
  1.  I $G(BARDBG) W !,"PAYMENT CREDIT APPLIED TO: ",BARTO
  1.  K DA S CNT=0
  1.  F DA=CLMDA,REVDA D
  1.  .S CNT=CNT+1
  1.  .K DR,DIE,DIC,DIR
  1.  .S DIE=$$DIC^XBDIQ1(90056.0205)
  1.  .I CNT=1 S TYPE=139  ;CREDIT FROM OTHER BILL
  1.  .E  S TYPE=138  ;CREDIT TO OTHER BILL
  1.  .S STAT="M"
  1.  .S DR=".02///^S X=STAT"
  1.  .S DR=DR_";501///^S X=TYPE"
  1.  .I CNT=1 S DR=DR_";602///^S X=BARFROM"
  1.  .E  S DR=DR_";601///^S X=BARTO"
  1.  .S DA(1)=IMPDA
  1.  .D ^DIE
  1.  .K DR,DIE,DIC,DIR
  1.  Q
  1. ISREV(CLMDA,IMPDA) ;P.OTT 1/10/2014 HEAT148388 BAR 1.8*24
  1.  I +$$GET1^DIQ(90056.0205,CLMDA_","_IMPDA_",",.11)=22 Q 1
  1.  Q 0
  1.  ;----------------