BAREDP04.m

BAREDP04 ; IHS/SD/LSL - MATCH REASONS AND CLAIMS ; 01/09/2009

 ;;1.8;IHS ACCOUNTS RECEIVABLE;**5,6,10,20,21,22,23,24,28**;OCT 26, 2005;Build 92

 ;IHS/SD/POT APR 2012 HEAT62015 BUG FIX: DO NOT CALL ^%DT IF DOS=""

 ;IHS/SD/POT OCT 2012 HEAT87149 FIXING LINE +210 - BAR 1.8*23

 ;IHS/SD/POT NOV 2012 HEAT82698 LEADING ZEROES IN BILL # - BAR 1.8*23

 ;IHS/SD/POT DEC 2012 FIX INIT VALUE OF CLMDA (+27) - BAR 1.8*23

 ;IHS/SD/POT HEAT147572 ALLOW TRIBAL SITES ERA POSTING OF NEG BAL & CANCELLED BILLS - BAR 1.8*24

 ;IHS/SD/POT NOHEAT PROCESS ZERO (0) IN CLP(1)  - BAR 1.8*24

 ;IHS/DIT/CPC CR9572 REMOVE OVER-RIDE REASON NOT TO POST WHEN MANUALLY MATCH - BAR*1.8*28

 Q

EN(TRDA,IMPDA)  ;EP ;SCAN CLMS BUILT "B" STATUS

 N REVERSAL,ERACHECK

 D INIT^BARUTL

 W !,"Matching E-Claims to A/R Bills and Reason Codes",!

 I TRNAME["HIPAA" D  Q

 .S INDEX="B"

 .D INDEX,PRT^BAR50DET

 F INDEX="B","X","C","R" D INDEX,PRT^BAR50DET

 Q

 ;--------------

INDEX    ;EP

 S QFLG=0

 W !,"Processing Claim Status using claim Index ",INDEX,!  ;bar*1.8*20 REQ4

 K ^XTMP("BAR-LIST_DETAIL",$J,DUZ(2)) ;BAR 1.8*24

 K ^XTMP("BAR-LIST",$J,DUZ(2))

 S BARDBG=1

 S BARMSG="PERFORMING TRADITIONAL HIPAA CHECKS...("_$$FTYPE()_")" W !,BARMSG

 I $G(BARDBG) D INS^BAR50DET(BARMSG,0)

 K BARFLG

 S CLMDA=0 F  S CLMDA=$O(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA)) Q:'CLMDA  D

 .S ^XTMP("BAR-LIST",$J,DUZ(2),$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U),CLMDA)=""

 S CLMCNT=0 S BARBL="" F  S BARBL=$O(^XTMP("BAR-LIST",$J,DUZ(2),BARBL)) Q:BARBL=""  D  Q:QFLG=1

 .S CLMDA=0 F  S CLMDA=$O(^XTMP("BAR-LIST",$J,DUZ(2),BARBL,CLMDA)) Q:'CLMDA  D  Q:QFLG=1

 ..K ERRORS D CLMFLG(CLMDA,.ERRORS)

 Q:QFLG=1

 S BARFLG=$$EN^BAREDP0Z(IMPDA)  ;PLB/Pymt Rev/Neg pymt amt chks

 ;;;old code D:$$IHS^BARUFUT(DUZ(2)) NEGBAL^BAREDEB(IMPDA,"ERA")  ;CHK FOR NEG BAL IN RPMS BILLS  BAR 1.8*24

 D NEGBAL^BAR50EB(IMPDA,"ERA")  ;note: IHS/TRIBAL CHK INSIDE BAR50EB CHK FOR NEG BAL IN RPMS BILLS HEAT147572  BAR 1.8*24

 ;NOTE: MATCHED PYMTS & CREDITS W/HAVE THE 'POST THIS CLM AS TYPE' FLD = TO 20=PYMT CREDIT

 ;BAR*1.8*6 TPF MOVE REV CHK TO BAREDEP AS A FULL LOOP CHK

 ;;;old code D:$$IHS^BARUFUT(DUZ(2)) NONPAYCH^BAREDEP1(IMPDA)  ;CHK FOR PYMTS NOT MATCHED TO REV TO SEE IF BEING POSTED TO 'NONPYMT' BATCH

 D:$$IHSNEGB^BARUFUT(DUZ(2)) NONPAYCH^BAREDEP1(IMPDA)  ;CHK FOR PYMTS NOT MATCHED TO REV TO SEE IF BEING POSTED TO 'NONPYMT' BATCH  BAR 1.8*24

 K ERRORS

 Q

 ;-------------- 

CLMFLG(CLMDA,ERRORS) ;

 ;NEXT LINE MOVED TO TOP OF THE SUBR

 I (($P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,2)),U))'=($P($G(^BAREDI("I",DUZ(2),IMPDA,5,BARCKIEN,0)),U)))  D  Q  ;only look at 1 chk's clms  ; REQ4

 .;;;I $G(BARDBG) W " 1ST CHK  - SKIP"

 NEW BARTMPM,BARTMPCL ;RETURN FLAG

 S BILMATCH=0  ;

 S BARTMPCL=$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U)

 I $G(BARDBG) D

 .D INS^BAR50DET($$LINE(),0)

 .S BARMSG="PROCESSING ENTRY: "_$J(CLMDA,6)_"  CLAIM "_BARTMPCL W !,BARMSG

 .D INS^BAR50DET(BARMSG,0)

 I $P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,2)="P"  D  Q  ;quit if posted

 .I $G(BARDBG) D INS^BAR50DET(" POSTED - SKIP",1)

 I $$OVERIDE^BAREDEP1(CLMDA) D  Q   ;MRS:BAR*1.8*10 D159-1 & 2

 .I $G(BARDBG) D INS^BAR50DET(" OVERRIDE - SKIP",1)

 I $P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,2)="E" D  Q  ;user marked as Exception-skip

 .I $G(BARDBG) D INS^BAR50DET(" EXCEPTION - SKIP",1)

 D DELREAS(IMPDA,CLMDA)  ;CLR ERRORS, SET STAT TO MATCHED, BEGIN BY ASSUMING ALL CLMS ARE MATCHED & ERROR FREE

 ;CHK & SET CLM MATCHING STATUS

 ;--------------------------

 I TRNAME["HIPAA" D

 .;;;I $G(BARDBG) W !,"PERFORMING TRADITIONAL HIPAA CHECKS FOR CLAIM ",$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U)

 .S CLMCNT=+$G(CLMCNT)+1

 .S CLMFLG=$$HIPAACLM(IMPDA,CLMDA,.ERRORS)

 .Q:$G(QFLG)=1

 .S REAFLG=$$HIPAAREA(IMPDA,CLMDA,.ERRORS)

 Q:$G(QFLG)=1

 ;---------------------------

 I TRNAME'["HIPAA" D

 .S CLMFLG=$$CLM(CLMDA)

 .S REAFLG=$$REA(CLMDA)

 ;

 ;------------ upd status in ^BAREDI ----------

 ;

 S STAT=""

 I CLMFLG,REAFLG S STAT="M"   ;MATCHED

 I 'CLMFLG,REAFLG S STAT="C"  ;CLM UNMATCHED

 I CLMFLG,'REAFLG S STAT="M"

 I 'CLMFLG,'REAFLG S STAT="C"

 K DR,DIE,DA

 S DIE=$$DIC^XBDIQ1(90056.0205)

 S DR=".02////^S X=STAT"

 S DA(1)=IMPDA

 S DA=CLMDA

 D ^DIE

 ;-------------------------------------------

 I TRNAME["HIPAA" D

 .I '$G(REAFLG),$G(REATYP)="RT" S STAT="RT"  ;RSN CD NOT DEFINED IN STD TBL  ;ADDED $G ;IHS/DIT/CPC - BAR*1.8*28

 .I '$G(REAFLG),$G(REATYP)="RF" S STAT="RF"  ;RSN CD NOT ON RA  ;ADDED $G ;IHS/DIT/CPC - BAR*1.8*28

 .I '$G(REAFLG),$G(REATYP)="RU" S STAT="RU"  ;STD ADJ CD NOT MAPPED TO RPMS  ;ADDED $G ;IHS/DIT/CPC - BAR*1.8*28

 .I '$G(CLMFLG),$G(CLMTYP)="CF" S STAT="CF"  ;CLM# (CLP01) NOT SENT ON RA ;ADDED $G ;IHS/DIT/CPC - BAR*1.8*28

 .I '$G(CLMFLG),$G(CLMTYP)="CT" S STAT="CT"  ;RA CLM NOT FOUND IN RPMS  ;ADDED $G ;IHS/DIT/CPC - BAR*1.8*28

 .I '$G(CLMFLG),$G(CLMTYP)="CC" S STAT="CC"  ;RA CLM IN RPMS AR BUT CANCELLED IN 3P  ;ADDED $G ;IHS/DIT/CPC - BAR*1.8*28

 .I '$G(CLMFLG),$G(CLMTYP)="CD" S STAT="CD"  ;DOS DOESN'T MATCH RPMS  ;ADDED $G ;IHS/DIT/CPC - BAR*1.8*28

 ;RSNS FOUND FOR 'NOT TO POST' (OLD)

 I $D(ERRORS("CT")) K ERRORS S ERRORS("CT")=""

 I $D(ERRORS("DUPB")) K ERRORS S ERRORS("DUPB")=""

 I $D(ERRORS) D ADDREAS(IMPDA,CLMDA,.ERRORS)

 ;CHKS FOR RSNS 'NOT TO POST'

 K ERRORS,STAT,REA,READA,REASDA,REAFLG,BARMSG,CLMTYP,REATYP  ;IHS/DIT/CPC - BAR*1.8*28

 Q

CLM(CLMDA) ;EP ;MATCH/SET/FLAG E-CLM TO A/R BILL

 S X=$$VAL^XBDIQ1(90056.0205,"IMPDA,CLMDA",.01)

 K DIC,DA,DR

 S DIC=90050.01

 S DIC(0)="M"

 D ^DIC

 I Y'>0 Q 0

 S BARBLDA=+Y

 S DIE=$$DIC^XBDIQ1(90056.0205)

 S DA=CLMDA

 S DA(1)=IMPDA

 S DR="1.01////^S X=BARBLDA"

 D ^DIE

 Q 1

 ;--------------

REA(CLMDA) ;EP ;LOOP MATCH/SET/FLAG RSN CODES OF E-CLM

 K ADJ

 S REAFLG=1

 S ADJDA=0

 F  S ADJDA=$O(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,30,ADJDA)) Q:ADJDA'>0  D

 .S ACAT=$$VALI^XBDIQ1(90056.0208,"IMPDA,CLMDA,ADJDA",.04)

 .S AREA=$$VALI^XBDIQ1(90056.0208,"IMPDA,CLMDA,ADJDA",.05)

 .S REA=$$VAL^XBDIQ1(90056.0208,"IMPDA,CLMDA,ADJDA",.03) ; pull rsn

 .I '$L(REA) S REAFLG=0 Q

 .;lookup rsn in rsn table

 .K DIC,DA,DR

 .S DIC=$$DIC^XBDIQ1(90056.0107)

 .S DA(1)=TRDA

 .S X=$P(REA," ")

 .S DIC(0)="X"

 .D ^DIC

 .I Y'>0 D  Q

 ..S BARMSG=" NO REASON "_X W !,BARMSG

 ..I $G(BARDBG) D INS^BAR50DET(BARMSG,0)

 ..S REAFLG=0

 .S READA=+Y

 .;line below to ignore inpt w/non-cov'd days

 .I +CLMFLG>0,$P($G(^BARBL(DUZ(2),BARBLDA,1)),U,14)=111,$P(Y,U,2)=96 Q

 .Q:$P(Y,U,2)=93    ;Q if rsn is 93 w/o attempting to match

 .;pull A/R cat & rsn

 .S ACAT=$$VALI^XBDIQ1(90056.0107,"TRDA,READA",2.01)

 .S AREA=$$VALI^XBDIQ1(90056.0107,"TRDA,READA",2.02)

 .I ACAT,AREA D SETREA I 1

 .E  S REAFLG=0

 Q REAFLG

  ;-------------

SETREA   ;EP SET CAT & REA INTO E-CLM

 K DIC,DIE,DR,DA

 S DIE=$$DIC^XBDIQ1(90056.0208)

 S DA(2)=IMPDA

 S DA(1)=CLMDA,DA=ADJDA

 S DR=".04////^S X=ACAT;.05////^S X=AREA"

 D ^DIE

 Q

HIPAAREA(IMPDA,CLMDA,ERRORS) ;BAR*1.8*5 SRS-80 TPF ERRORS CAN BE MULTIPLE

 ; Match HIPAA std codes to RPMS

 K ADJ

 S REAFLG=1

 S ADJDA=0

 F  S ADJDA=$O(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,30,ADJDA)) Q:'+ADJDA  D HIPAAR2

 Q REAFLG

HIPAAR2  ; Match HIPAA std codes to RPMS

 S REA=$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,30,ADJDA,0)),U,3)

 I REA="" D  ;

 .W !,"Standard adjustment reason not sent on RA."

 .S REAFLG=0

 .S REATYP="RF"

 .S ERRORS("RF")=""

 S ACAT=$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,30,ADJDA,0)),U,4)

 S AREA=$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,30,ADJDA,0)),U,5)

 K DIC,DR,DA

 S DIC="^BARADJ("

 S X=$P(REA," ")

 S DIC(0)="XZ"

 D ^DIC

 I +Y<1 D  Q

 .W !,"Standard adjustment reason ",X," not in standard table."

 .S REAFLG=0

 .S REATYP="RT"

 .S ERRORS("RT")="" ;BAR*1.8*5 SRS-80 TPF

 S READA=+Y

 ;No RPMS cat/type in table

 I $P(Y(0),U,3)=""!($P(Y(0),U,4)="") D  ;

 .W !,"Can't map standard adjustment reason ",X," to RPMS."

 .S REAFLG=0

 .S REATYP="RU"

 .S ERRORS("RU")="" ;BAR*1.8*5 SRS-80 TPF

 K DIC,DA,DR,DIE

 S DIE=$$DIC^XBDIQ1(90056.0208)

 S DA(2)=IMPDA

 S DA(1)=CLMDA

 S DA=ADJDA

 S DR=".04////^S X=$P(Y(0),U,3)"

 S DR=DR_";.05////^S X=$P(Y(0),U,4)"

 D ^DIE

 Q

HIPAACLM(IMPDA,CLMDA,ERRORS) ;BAR*1.8*5 SRS-80 TPF ERRORS CAN BE MULTIPLE

 N BARTMP,BARAMT,BARDOS,ERAAMT,ERADOS,ERATYPE,BARFND  ;

 ;Match RA clms to RPMS

 ;1st chk bill# "B" x-ref

 ;If not successful, chk other identifier "G" x-ref for Pharmacy POS

 S BAREIENS=CLMDA_","_IMPDA_","

 S BARTEST=$$GET1^DIQ(90056.0205,BAREIENS,.01) ;full string

 ;;;I (($A($E(BARTEST,$L($P(BARTEST,"-"))))>64)&($A($E(BARTEST,$L($P(BARTEST,"-"))))<91)) S BARBILL=BARBILL_$E(BARTEST,$L(BARBILL)+1)

 S (BARBIEN,BARBILL)=""  ;IHS/DIT/CPC BAR 1.8*28

 S (BARBIEN,BARBILL)=$$GETBBILL(BARTEST) ;BAR 1.8*23

 I BARTEST="" D

 .S CLMTYP="CF"

 .W !,"Bill number not sent on ERA"

 .S ERRORS("CF")=""

 K BARTMP ;INIT ARRAY

 S BARX="",BARFND=0

 D CLM^BAREDP4A(BAREIENS,BARBILL,.BARX,.BARMMFLG) ;bar*1.8*20 REQ4 split due to rtn size

 I BARFND=0 D

 .S BARMSG=$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U)_"  ***CLAIM NOT FOUND IN RPMS***"

 .W !,BARMSG ;IMPORTANT!

 .D INS^BAR50DET(BARMSG,0) ;SAME MESSAGE INTO REPORT

 .D NOMATCH^BAR50DET ;INDICATE NOT MATCH

 I $$GET1^DIQ(90056.0205,BAREIENS,1.01,"I")'="" S BARCNT=1  ; IENS->BAREIENS BAR 1.8*23

 I BARCNT=0 S CLMTYP="CT",ERRORS("CT")=""

 I BARCNT=1 S BARBIEN=$O(BARTMP(0))

 I BILMATCH=1 D  ;

 .S BARBIEN=$O(BILMATCH("")) S BARCNT=1

 .S BARMSG=$J("",5)_"ERA BILL "_$$GET1^DIQ(90056.0205,BAREIENS,.01) W !,BARMSG

 .I $G(BARDBG) D INS^BAR50DET(BARMSG,0)

 .S BARMSG=" MATCHED TO "_$S(BARX="G":"(POS)",1:"")_" A/R BILL "_$P($G(^BARBL(DUZ(2),BARBIEN,0)),U)

 .W BARMSG

 .I $G(BARDBG) D INS^BAR50DET(BARMSG,1)

 .;

 .;

CLM2     ;

 ;

 S NEWSTAT=$G(NEWSTAT) ;init value 12/12/2013

 I BARCNT>1,($$GET1^DIQ(90056.0205,BAREIENS,1.01)=""),('$D(BARRVW)) D   ;IHS/DIT/CPC - BAR*1.8*28

 .F  D  Q:($G(BARSEL)'="B"&($G(BARSEL)'="H"))

 ..D HDR

 ..D RABILL

 ..D ARBILL

 ..D CHOOSE

 ..I ($G(BARSEL)="Q") S QFLG=1 Q  ;bar*1.8*20

 ..I (+$G(BARANS)'=0)&(($G(BARSEL)'="B")&($G(BARSEL)'="H")) D

 ...K DIR

 ...S DIR(0)="Y"

 ...S DIR("A")="Are you sure?"

 ...S DIR("B")="N"

 ...D ^DIR

 ...I +Y<1 S BARANS=0 S BARSEL="B"

 .I $G(BARSEL)="" D

 ..W !!,"BILL WILL NOT BE MATCHED AND WILL BE SET TO 'NOT MATCHED'. CONTINUING.."

 ..S BARSEL="N"

 .I BARSEL="N" S NEWSTAT="M",ERRORS("DUPB")=""

 .I '+BARANS,BARSEL="N" Q  ;bar*1.8*20

 .I '+BARANS S CLMTYP="CT",ERRORS("CT")="" Q  ;BAR*1.8*5 SRS-80 TPF

 .S BARBIEN=BARTMP2(BARANS)

 ;Match DOS

 S (BARRADT,X)=$$GET1^DIQ(90056.0205,BAREIENS,.08) ;BAR 1.8*23

 I X]"" D ^%DT I Y'=-1 S BARRADT=Y  ;DOS begin

 S BARBDT=$$GET1^DIQ(90050.01,BARBIEN,102,"I")

 I BARRADT'=BARBDT S CLMTYP="CD",ERRORS("CD")=""  ;DOS DOESN'T MATCH RPMS ; BAR*1.8*5 SRS-80

 ;See if cancelled in 3P

 S BAR3PIEN=$$FIND3PB^BARUTL(DUZ(2),BARBIEN)

 I BAR3PIEN]"" D   ;BAR*1.8*5 SRS-80 TPF

 .;I $$IHSCANCB^BARUFUT(DUZ(2)) Q  ;allow cancelled bills 2/4/2014 BAR 1.8*24

 .I $$IHSCANCB^BARUFUT(DUZ(2)) D  Q  ;allow cancelled bills 2/4/14 ;Update reasons not to post IHS/DIT/CPC -20180423 1.8*28

 ..S ERRORS("CC")=""

 ..D ADDREAS(IMPDA,CLMDA,.ERRORS,SHOWMSG)

 .S BARBSTAT=$P($G(^ABMDBILL($P(BAR3PIEN,","),$P(BAR3PIEN,",",2),0)),U,4)

 .;S:BARBSTAT="X" CLMTYP="CC"  ;Cancelled in 3P  ;bar*1.8*28 IHS/DIT}

 .S:BARBSTAT="X" CLMTYP="CC",ERRORS("CC")=""  ;BAR*1.8*5 SRS-80 TPF ;bar*1.8*28 IHS/DIT} 

 D TRANSCK^BAREDP4A  ;bar*1.8*20 REQ6

 I $G(NEWSTAT)="M"!($$GET1^DIQ(90056.0205,BAREIENS,.02,"I")="M") Q 1  ;bar*1.8*20 REQ5

 Q:$D(ERRORS) 0  ;BAR*1.8*5 SRS-80 TPF

 ; Bill matches RPMS-log AR Bill IEN in Image

 S DIE=$$DIC^XBDIQ1(90056.0205)

 S DA=CLMDA

 S DA(1)=IMPDA

 S DR="1.01////^S X=BARBIEN"

 S MATCH="M"

 S DR=DR_";.02////^S X=MATCH"

 D ^DIE

 Q 1

HDR      ;hdr

 W !!,$$EN^BARVDF("ULN"),?4,"BILL #",?23,"DOS",?31,"PATIENT NAME"

 W ?57,"BILLED AMT",?71,"BALANCE",$$EN^BARVDF("ULF")

 Q

RABILL   ;Write RA data

 W !,$$EN^BARVDF("RVN")  ;bar*1.8*20

 W "ERA"  ;bar*1.8*20

 W ?4,$E($$GET1^DIQ(90056.0205,BAREIENS,.01),1,15)  ;BILL/RX  ;bar*1.8*20 REQ4

 S X=$$GET1^DIQ(90056.0205,BAREIENS,.08)

 D ^%DT

 S BARRADT=Y  ;DOS begin

 I X]"" W ?20,$$SDT^BARDUTL(BARRADT)  ;DOS begin

 I X="" W ?20,"DOS <nil>" ;BAR 1.8*23

 W ?31,$E($$GET1^DIQ(90056.0205,BAREIENS,.06),1,25)  ;Pt name

 W ?57,$J($FN($$GET1^DIQ(90056.0205,BAREIENS,.05),",",2),10)  ;Billed

 W $$EN^BARVDF("RVF")  ;bar*1.8*20

 Q

ARBILL   ;Loop & write AR data

 S (BARBIEN,BARCNT2)=0

 F  S BARBIEN=$O(BARTMP(BARBIEN)) Q:'+BARBIEN  D

 .S BARCNT2=BARCNT2+1

 .S BARBDT=$$GET1^DIQ(90050.01,BARBIEN,102,"I")

 .W !,$J(BARCNT2,2),")"

 .W ?4,$E($$GET1^DIQ(90050.01,BARBIEN,.01),1,15)

 .W ?20,$$SDT^BARDUTL(BARBDT)

 .W ?31,$E($$GET1^DIQ(90050.01,BARBIEN,101),1,25)

 .W ?52,$J($FN($$GET1^DIQ(90050.01,BARBIEN,13),",",2),10)

 .W ?68,$J($FN($$GET1^DIQ(90050.01,BARBIEN,15),",",2),10)

 .S BARTMP2(BARCNT2)=BARBIEN

 Q

CHOOSE   ;Choose bill from AR

 ;start new REQ4

 K DIR

 S DIR(0)="SABO^B:Bill Inquire;H:History;M:Match to Item;N:Not Matched;Q:Quit"

 S DIR("A")="Enter (B)ill Inquire,(H)istory,(M)atch to Item,(N)ot Matched,(Q)uit: "

 D ^DIR

 I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) S BARANS=0 Q

 S BARSEL=Y

 I BARSEL="N"!(BARSEL="Q") S BARANS=0 Q  ;not matched

 K DIR

 S DIR(0)="NAO^1:"_BARCNT2

 S DIR("A")="Which Entry: "

 S DIR("?")="Enter a number between 1 and "_BARCNT2

 D ^DIR

 I $D(DIROUT)!$D(DUOUT)!$D(DIRUT)!$D(DTOUT) S BARANS=0 Q

 S BARANS1=$G(BARTMP2(Y)),BARANS=Y

 I BARSEL="H" D

 .D EN^BARPST5(BARANS1)

 I BARSEL="B" D

 .D DIQ^XBLM(90050.01,BARANS1)

 Q

 ;

 ;DISPLAY ERRORS CODE MOVED TO BAREDP4B 

 ;

ADDREAS(IMPDA,CLMDA,ERRORS) ;EP - ADD RSN NOT SENT TO 'RSN NOT TO POST MULTIPLE'

 S SHOWMSG=$G(SHOWMSG)

 D ADDREAS^BAREDP4B(IMPDA,CLMDA,.ERRORS)

 Q

DELREAS(IMPDA,CLMDA) ;EP -CLR 'RSN NOT TO POST' MULTIPLES IN ERA FILE 

 D DELREAS^BAREDP4B(IMPDA,CLMDA) ;SAC REQ

 Q

 ;

GETBBILL(BARTMP) ;----------------------------------------------

 NEW BARBLNUM,I,CH

 S BARBLNUM="" F I=1:1:$L(BARTMP) S CH=$E(BARTMP,I) Q:CH'?1N  S BARBLNUM=BARBLNUM_CH

 I CH?1A S BARBLNUM=BARBLNUM_CH ;TAKE THE FIRST ALPHA AFTER NNNN

 I BARBLNUM="" Q ""

 Q BARBLNUM

 ;

LINE() ;

 NEW I,STR

 S STR="" F I=1:1:78 S STR=STR_"-"

 Q STR

FTYPE() ;

 I $ZN["BAR50" Q "5010"

 Q "4010"

BAREDP04  ; IHS/SD/LSL - MATCH REASONS AND CLAIMS ; 01/09/2009

 +1       ;;1.8;IHS ACCOUNTS RECEIVABLE;**5,6,10,20,21,22,23,24,28**;OCT 26, 2005;Build 92

 +2       ;IHS/SD/POT APR 2012 HEAT62015 BUG FIX: DO NOT CALL ^%DT IF DOS=""

 +3       ;IHS/SD/POT OCT 2012 HEAT87149 FIXING LINE +210 - BAR 1.8*23

 +4       ;IHS/SD/POT NOV 2012 HEAT82698 LEADING ZEROES IN BILL # - BAR 1.8*23

 +5       ;IHS/SD/POT DEC 2012 FIX INIT VALUE OF CLMDA (+27) - BAR 1.8*23

 +6       ;IHS/SD/POT HEAT147572 ALLOW TRIBAL SITES ERA POSTING OF NEG BAL & CANCELLED BILLS - BAR 1.8*24

 +7       ;IHS/SD/POT NOHEAT PROCESS ZERO (0) IN CLP(1)  - BAR 1.8*24

 +8       ;IHS/DIT/CPC CR9572 REMOVE OVER-RIDE REASON NOT TO POST WHEN MANUALLY MATCH - BAR*1.8*28

 +9        QUIT 

EN(TRDA,IMPDA) ;EP ;SCAN CLMS BUILT "B" STATUS

 +1        NEW REVERSAL,ERACHECK

 +2        DO INIT^BARUTL

 +3        WRITE !,"Matching E-Claims to A/R Bills and Reason Codes",!

 +4        IF TRNAME["HIPAA"

               Begin DoDot:1

 +5                SET INDEX="B"

 +6                DO INDEX

                   DO PRT^BAR50DET

               End DoDot:1

               QUIT 

 +7        FOR INDEX="B","X","C","R"

               DO INDEX

               DO PRT^BAR50DET

 +8        QUIT 

 +9       ;--------------

INDEX     ;EP

 +1        SET QFLG=0

 +2       ;bar*1.8*20 REQ4

           WRITE !,"Processing Claim Status using claim Index ",INDEX,!

 +3       ;BAR 1.8*24

           KILL ^XTMP("BAR-LIST_DETAIL",$JOB,DUZ(2))

 +4        KILL ^XTMP("BAR-LIST",$JOB,DUZ(2))

 +5        SET BARDBG=1

 +6        SET BARMSG="PERFORMING TRADITIONAL HIPAA CHECKS...("_$$FTYPE()_")"

           WRITE !,BARMSG

 +7        IF $GET(BARDBG)

               DO INS^BAR50DET(BARMSG,0)

 +8        KILL BARFLG

 +9        SET CLMDA=0

           FOR 

               SET CLMDA=$ORDER(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA))

               IF 'CLMDA

                   QUIT 

               Begin DoDot:1

 +10               SET ^XTMP("BAR-LIST",$JOB,DUZ(2),$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U),CLMDA)=""

               End DoDot:1

 +11       SET CLMCNT=0

           SET BARBL=""

           FOR 

               SET BARBL=$ORDER(^XTMP("BAR-LIST",$JOB,DUZ(2),BARBL))

               IF BARBL=""

                   QUIT 

               Begin DoDot:1

 +12               SET CLMDA=0

                   FOR 

                       SET CLMDA=$ORDER(^XTMP("BAR-LIST",$JOB,DUZ(2),BARBL,CLMDA))

                       IF 'CLMDA

                           QUIT 

                       Begin DoDot:2

 +13                       KILL ERRORS

                           DO CLMFLG(CLMDA,.ERRORS)

                       End DoDot:2

                       IF QFLG=1

                           QUIT 

               End DoDot:1

               IF QFLG=1

                   QUIT 

 +14       IF QFLG=1

               QUIT 

 +15      ;PLB/Pymt Rev/Neg pymt amt chks

           SET BARFLG=$$EN^BAREDP0Z(IMPDA)

 +16      ;;;old code D:$$IHS^BARUFUT(DUZ(2)) NEGBAL^BAREDEB(IMPDA,"ERA")  ;CHK FOR NEG BAL IN RPMS BILLS  BAR 1.8*24

 +17      ;note: IHS/TRIBAL CHK INSIDE BAR50EB CHK FOR NEG BAL IN RPMS BILLS HEAT147572  BAR 1.8*24

           DO NEGBAL^BAR50EB(IMPDA,"ERA")

 +18      ;NOTE: MATCHED PYMTS & CREDITS W/HAVE THE 'POST THIS CLM AS TYPE' FLD = TO 20=PYMT CREDIT

 +19      ;BAR*1.8*6 TPF MOVE REV CHK TO BAREDEP AS A FULL LOOP CHK

 +20      ;;;old code D:$$IHS^BARUFUT(DUZ(2)) NONPAYCH^BAREDEP1(IMPDA)  ;CHK FOR PYMTS NOT MATCHED TO REV TO SEE IF BEING POSTED TO 'NONPYMT' BATCH

 +21      ;CHK FOR PYMTS NOT MATCHED TO REV TO SEE IF BEING POSTED TO 'NONPYMT' BATCH  BAR 1.8*24

           IF $$IHSNEGB^BARUFUT(DUZ(2))

               DO NONPAYCH^BAREDEP1(IMPDA)

 +22       KILL ERRORS

 +23       QUIT 

 +24      ;-------------- 

CLMFLG(CLMDA,ERRORS) ;

 +1       ;NEXT LINE MOVED TO TOP OF THE SUBR

 +2       ;only look at 1 chk's clms  ; REQ4

           IF (($PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,2)),U))'=($PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,5,BARCKIEN,0)),U)))

               Begin DoDot:1

 +3       ;;;I $G(BARDBG) W " 1ST CHK  - SKIP"

               End DoDot:1

               QUIT 

 +4       ;RETURN FLAG

           NEW BARTMPM,BARTMPCL

 +5       ;

           SET BILMATCH=0

 +6        SET BARTMPCL=$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U)

 +7        IF $GET(BARDBG)

               Begin DoDot:1

 +8                DO INS^BAR50DET($$LINE(),0)

 +9                SET BARMSG="PROCESSING ENTRY: "_$JUSTIFY(CLMDA,6)_"  CLAIM "_BARTMPCL

                   WRITE !,BARMSG

 +10               DO INS^BAR50DET(BARMSG,0)

               End DoDot:1

 +11      ;quit if posted

           IF $PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,2)="P"

               Begin DoDot:1

 +12               IF $GET(BARDBG)

                       DO INS^BAR50DET(" POSTED - SKIP",1)

               End DoDot:1

               QUIT 

 +13      ;MRS:BAR*1.8*10 D159-1 & 2

           IF $$OVERIDE^BAREDEP1(CLMDA)

               Begin DoDot:1

 +14               IF $GET(BARDBG)

                       DO INS^BAR50DET(" OVERRIDE - SKIP",1)

               End DoDot:1

               QUIT 

 +15      ;user marked as Exception-skip

           IF $PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,2)="E"

               Begin DoDot:1

 +16               IF $GET(BARDBG)

                       DO INS^BAR50DET(" EXCEPTION - SKIP",1)

               End DoDot:1

               QUIT 

 +17      ;CLR ERRORS, SET STAT TO MATCHED, BEGIN BY ASSUMING ALL CLMS ARE MATCHED & ERROR FREE

           DO DELREAS(IMPDA,CLMDA)

 +18      ;CHK & SET CLM MATCHING STATUS

 +19      ;--------------------------

 +20       IF TRNAME["HIPAA"

               Begin DoDot:1

 +21      ;;;I $G(BARDBG) W !,"PERFORMING TRADITIONAL HIPAA CHECKS FOR CLAIM ",$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U)

 +22               SET CLMCNT=+$GET(CLMCNT)+1

 +23               SET CLMFLG=$$HIPAACLM(IMPDA,CLMDA,.ERRORS)

 +24               IF $GET(QFLG)=1

                       QUIT 

 +25               SET REAFLG=$$HIPAAREA(IMPDA,CLMDA,.ERRORS)

               End DoDot:1

 +26       IF $GET(QFLG)=1

               QUIT 

 +27      ;---------------------------

 +28       IF TRNAME'["HIPAA"

               Begin DoDot:1

 +29               SET CLMFLG=$$CLM(CLMDA)

 +30               SET REAFLG=$$REA(CLMDA)

               End DoDot:1

 +31      ;

 +32      ;------------ upd status in ^BAREDI ----------

 +33      ;

 +34       SET STAT=""

 +35      ;MATCHED

           IF CLMFLG

               IF REAFLG

                   SET STAT="M"

 +36      ;CLM UNMATCHED

           IF 'CLMFLG

               IF REAFLG

                   SET STAT="C"

 +37       IF CLMFLG

               IF 'REAFLG

                   SET STAT="M"

 +38       IF 'CLMFLG

               IF 'REAFLG

                   SET STAT="C"

 +39       KILL DR,DIE,DA

 +40       SET DIE=$$DIC^XBDIQ1(90056.0205)

 +41       SET DR=".02////^S X=STAT"

 +42       SET DA(1)=IMPDA

 +43       SET DA=CLMDA

 +44       DO ^DIE

 +45      ;-------------------------------------------

 +46       IF TRNAME["HIPAA"

               Begin DoDot:1

 +47      ;RSN CD NOT DEFINED IN STD TBL  ;ADDED $G ;IHS/DIT/CPC - BAR*1.8*28

                   IF '$GET(REAFLG)

                       IF $GET(REATYP)="RT"

                           SET STAT="RT"

 +48      ;RSN CD NOT ON RA  ;ADDED $G ;IHS/DIT/CPC - BAR*1.8*28

                   IF '$GET(REAFLG)

                       IF $GET(REATYP)="RF"

                           SET STAT="RF"

 +49      ;STD ADJ CD NOT MAPPED TO RPMS  ;ADDED $G ;IHS/DIT/CPC - BAR*1.8*28

                   IF '$GET(REAFLG)

                       IF $GET(REATYP)="RU"

                           SET STAT="RU"

 +50      ;CLM# (CLP01) NOT SENT ON RA ;ADDED $G ;IHS/DIT/CPC - BAR*1.8*28

                   IF '$GET(CLMFLG)

                       IF $GET(CLMTYP)="CF"

                           SET STAT="CF"

 +51      ;RA CLM NOT FOUND IN RPMS  ;ADDED $G ;IHS/DIT/CPC - BAR*1.8*28

                   IF '$GET(CLMFLG)

                       IF $GET(CLMTYP)="CT"

                           SET STAT="CT"

 +52      ;RA CLM IN RPMS AR BUT CANCELLED IN 3P  ;ADDED $G ;IHS/DIT/CPC - BAR*1.8*28

                   IF '$GET(CLMFLG)

                       IF $GET(CLMTYP)="CC"

                           SET STAT="CC"

 +53      ;DOS DOESN'T MATCH RPMS  ;ADDED $G ;IHS/DIT/CPC - BAR*1.8*28

                   IF '$GET(CLMFLG)

                       IF $GET(CLMTYP)="CD"

                           SET STAT="CD"

               End DoDot:1

 +54      ;RSNS FOUND FOR 'NOT TO POST' (OLD)

 +55       IF $DATA(ERRORS("CT"))

               KILL ERRORS

               SET ERRORS("CT")=""

 +56       IF $DATA(ERRORS("DUPB"))

               KILL ERRORS

               SET ERRORS("DUPB")=""

 +57       IF $DATA(ERRORS)

               DO ADDREAS(IMPDA,CLMDA,.ERRORS)

 +58      ;CHKS FOR RSNS 'NOT TO POST'

 +59      ;IHS/DIT/CPC - BAR*1.8*28

           KILL ERRORS,STAT,REA,READA,REASDA,REAFLG,BARMSG,CLMTYP,REATYP

 +60       QUIT 

CLM(CLMDA) ;EP ;MATCH/SET/FLAG E-CLM TO A/R BILL

 +1        SET X=$$VAL^XBDIQ1(90056.0205,"IMPDA,CLMDA",.01)

 +2        KILL DIC,DA,DR

 +3        SET DIC=90050.01

 +4        SET DIC(0)="M"

 +5        DO ^DIC

 +6        IF Y'>0

               QUIT 0

 +7        SET BARBLDA=+Y

 +8        SET DIE=$$DIC^XBDIQ1(90056.0205)

 +9        SET DA=CLMDA

 +10       SET DA(1)=IMPDA

 +11       SET DR="1.01////^S X=BARBLDA"

 +12       DO ^DIE

 +13       QUIT 1

 +14      ;--------------

REA(CLMDA) ;EP ;LOOP MATCH/SET/FLAG RSN CODES OF E-CLM

 +1        KILL ADJ

 +2        SET REAFLG=1

 +3        SET ADJDA=0

 +4        FOR 

               SET ADJDA=$ORDER(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,30,ADJDA))

               IF ADJDA'>0

                   QUIT 

               Begin DoDot:1

 +5                SET ACAT=$$VALI^XBDIQ1(90056.0208,"IMPDA,CLMDA,ADJDA",.04)

 +6                SET AREA=$$VALI^XBDIQ1(90056.0208,"IMPDA,CLMDA,ADJDA",.05)

 +7       ; pull rsn

                   SET REA=$$VAL^XBDIQ1(90056.0208,"IMPDA,CLMDA,ADJDA",.03)

 +8                IF '$LENGTH(REA)

                       SET REAFLG=0

                       QUIT 

 +9       ;lookup rsn in rsn table

 +10               KILL DIC,DA,DR

 +11               SET DIC=$$DIC^XBDIQ1(90056.0107)

 +12               SET DA(1)=TRDA

 +13               SET X=$PIECE(REA," ")

 +14               SET DIC(0)="X"

 +15               DO ^DIC

 +16               IF Y'>0

                       Begin DoDot:2

 +17                       SET BARMSG=" NO REASON "_X

                           WRITE !,BARMSG

 +18                       IF $GET(BARDBG)

                               DO INS^BAR50DET(BARMSG,0)

 +19                       SET REAFLG=0

                       End DoDot:2

                       QUIT 

 +20               SET READA=+Y

 +21      ;line below to ignore inpt w/non-cov'd days

 +22               IF +CLMFLG>0

                       IF $PIECE($GET(^BARBL(DUZ(2),BARBLDA,1)),U,14)=111

                           IF $PIECE(Y,U,2)=96

                               QUIT 

 +23      ;Q if rsn is 93 w/o attempting to match

                   IF $PIECE(Y,U,2)=93

                       QUIT 

 +24      ;pull A/R cat & rsn

 +25               SET ACAT=$$VALI^XBDIQ1(90056.0107,"TRDA,READA",2.01)

 +26               SET AREA=$$VALI^XBDIQ1(90056.0107,"TRDA,READA",2.02)

 +27               IF ACAT

                       IF AREA

                           DO SETREA

                           IF 1

 +28              IF '$TEST

                       SET REAFLG=0

               End DoDot:1

 +29       QUIT REAFLG

 +30      ;-------------

SETREA    ;EP SET CAT & REA INTO E-CLM

 +1        KILL DIC,DIE,DR,DA

 +2        SET DIE=$$DIC^XBDIQ1(90056.0208)

 +3        SET DA(2)=IMPDA

 +4        SET DA(1)=CLMDA

           SET DA=ADJDA

 +5        SET DR=".04////^S X=ACAT;.05////^S X=AREA"

 +6        DO ^DIE

 +7        QUIT 

HIPAAREA(IMPDA,CLMDA,ERRORS) ;BAR*1.8*5 SRS-80 TPF ERRORS CAN BE MULTIPLE

 +1       ; Match HIPAA std codes to RPMS

 +2        KILL ADJ

 +3        SET REAFLG=1

 +4        SET ADJDA=0

 +5        FOR 

               SET ADJDA=$ORDER(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,30,ADJDA))

               IF '+ADJDA

                   QUIT 

               DO HIPAAR2

 +6        QUIT REAFLG

HIPAAR2   ; Match HIPAA std codes to RPMS

 +1        SET REA=$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,30,ADJDA,0)),U,3)

 +2       ;

           IF REA=""

               Begin DoDot:1

 +3                WRITE !,"Standard adjustment reason not sent on RA."

 +4                SET REAFLG=0

 +5                SET REATYP="RF"

 +6                SET ERRORS("RF")=""