BAREDEB ; IHS/SD/TPF - AR ERA BALANCE CHECKER ; 01/28/2009
;;1.8;IHS ACCOUNTS RECEIVABLE;**5,6,10,20,22,23,24**;OCT 26,2005;Build 69
;
;THIS RTN CONTAINS THE BALANCE CHECKING NEED SO ERA POSTING DOES NOT ALLOW
;POSTING WHICH WILL NOT BE ACCEPTED BY UFMS
;
;BATCH - CHECKS THE TRANSACTIONS WITHIN A SINGLE ERA FILE BEING POSTED
;AGAINST A BATCH. THE PAYMENTS/ADJUSTMENTS FROM THE ERA FILE MUST BE <= THE
;BATCH AMOUNT (#29) AND THE BATCH AMOUNT (#29) MUST BE >=0
;
;IHS/SD/POT HEAT82698 NOV 2012 LEADING ZEROES IN CHKECK # (POS) - BAR 1.8*23
;; MAR 2013 EXCLUDED COL BATCHES OLDER THAN 365 DAYS
;IHS/SD/POT HEAT147572 2/5/2014 ALLOW TRIBAL SITES ERA POSTING OF NEG BAL & CANCELLED BILLS - BAR 1.8*24
;IHS/SD/POT HEAT151948 2/6/2014 FIXED PENDING ADJ. (NEGATIVE BILL BALANCE)- BAR 1.8*24
Q
;
;TYPE = "ERA" FOR INTERNAL ERA FILE CHECK, RPMS = COMPARE ERA TO RPMS BILL
NEGBAL(IMPDA,TYPE) ;EP - CHECK FOR NEGATIVE BALANCE W/IN ERA AND IF POSTED AGAINST RPMS
Q:$G(TYPE)=""
I $G(BARDBG) W !!!,"CHECKING FOR NEGATIVE BALANCE IF MATCHED ERA CLAIMS ARE POSTED..."
N BARBILL,BARANS,BARTOT,BARPAY,BARADJ,ADJDA,ERRORS,CHECKTOT,ALLADJ
N ERACHECK,CLMDA,TCLMDA,CLM,ERRORS,BILLCHOS,BARTYPE,BARREAS
S (BARBAL,BARTOT,ALLADJ)=0
K CHECKTOT
S BARBILL=""
K BARCNT,BARAMT,BARTOT ;bar*1.8*20
S CLMCNT=0
S CLMDA=0
K ^XTMP("BAR-LIST",$J,DUZ(2))
F S CLMDA=$O(^BAREDI("I",DUZ(2),"F",BARCHK,IMPDA,CLMDA)) Q:'CLMDA D
.S BARBILL=$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U)
.S ^XTMP("BAR-LIST",$J,DUZ(2),BARBILL,CLMDA)=""
S BARBILL=""
F S BARBILL=$O(^XTMP("BAR-LIST",$J,DUZ(2),BARBILL)) Q:BARBILL="" D
.;S CLMCNT=+$G(CLMCNT)+1 ;bar*1.8*20 REQ4 ;bar*1.8*22 SDR
.S BARPAY=0
.S CLMDA=0,BILLCHOS=""
.F S CLMDA=$O(^BAREDI("I",DUZ(2),IMPDA,30,"B",BARBILL,CLMDA)) Q:'CLMDA D
..S CLMCNT=CLMCNT+1
..S (BARTOT,BARADJ,BARPAY)=0
..S BILLCHOS=$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,1)),U) ;A-CLAIM ; IF THIS IS POPULATED THEN THE CORRCET BILL WAS FOUND OR CHOSEN ALREADY
..S BARSTAT=$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,2) ;bar*1.8*20 REQ5
..S BARTOT("CNT")=+$G(BARTOT("CNT"))+1,BARTOT("AMT")=+$G(BARTOT("AMT"))+$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,4) ;bar*1.8*20
..I BARSTAT="M" S BARCNT("MATCHED")=+$G(BARCNT("MATCHED"))+1,BARAMT("MATCHED")=+$G(BARAMT("MATCHED"))+$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,4) ;bar*1.8*20
..I BARSTAT'="M" S BARCNT("UNMATCHED")=+$G(BARCNT("UNMATCHED"))+1,BARAMT("UNMATCHED")=+$G(BARAMT("UNMATCHED"))+$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,4) ;bar*1.8*20
..Q:BARSTAT'="M" ;only display matched claims bar*1.8*20
..I $G(BARDBG) W !!,CLMCNT,?4,"ERA BILL: ",BARBILL ;bar*1.8*20 REQ4
..I BILLCHOS S BARBLIEN=BILLCHOS
..E S BARBLIEN=$$GETIEN("B",BARBILL)
..I BARBLIEN="BILL NOT FOUND" D
...;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
..I BARBLIEN="DUPLICATE BILLS FOUND" D
...S ERRORS("DUPB")="" ;DUPLICATE BILLS FOUND IN RPMS
..I BARBLIEN S BARBAL=$$GET1^DIQ(90050.01,BARBLIEN_",",15,"I") ;CURRENT BILL AMOUNT
..E S BARBAL=0
..I $G(BARDBG) W ?41,"CURRENT BILL AMT(RPMS): ",$J($FN(BARBAL,",",2),14) ;bar*1.8*20 REQ4
..;
..S BARADJ=0
.. I $$DONOTPR(IMPDA,CLMDA) Q
.. ;Q:$$OVERIDE^BAR50EP1(CLMDA) ;MRS:BAR*1.8*10 D159-1 AND 2
.. ;Q:$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,2)="P" ;DON'T PROCESS POSTED CLAIMS
.. ;S CLSTATUS=$P($P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,11)," ") ;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
.. ;Q:(U_"1"_U_"2"_U_"3"_U_"4"_U_"19"_U_"20"_U_"21"_U_"22"_U)'[(U_CLSTATUS_U) ;ADDED 4 (DENIALS) PER EMAIL OF 7/31
.. ;DENIAL ADJUSTMENTS CLP02=4 WERE CREATING NEGATIVE BALANCES
..S ERACHECK=$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,2)),U)
..S BARAMT=$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,4)
..S BARPAY=BARPAY+BARAMT
..I $G(BARDBG) W !?3,$S(BARBILL'=$$GET1^DIQ(90050.01,BILLCHOS,".01"):"("_$$GET1^DIQ(90050.01,BILLCHOS,".01")_")",1:""),?59,"PYMT: ",$J($FN(BARAMT,",",2),14) ;bar*1.8*20 REQ4
..;
..S CHECKTOT(ERACHECK)=$G(CHECKTOT(ERACHECK))+BARAMT
..S ADJDA=0
..F S ADJDA=$O(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,30,ADJDA)) Q:'+ADJDA D
...S BARAMT=$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,30,ADJDA,0)),U,2)
...S BARCAT=$$GET1^DIQ(90056.0208,ADJDA_","_CLMDA_","_IMPDA_",",.04,"E")
...S BARCATN=$$GET1^DIQ(90056.0208,ADJDA_","_CLMDA_","_IMPDA_",",.04,"I") ;P.OTT 2/6/2014 HEAT151948
...S BARREAS=$$GET1^DIQ(90056.0208,ADJDA_","_CLMDA_","_IMPDA_",",.05,"E")
...I $G(BARDBG) W !?3,"A/R CAT:",$E(BARCAT,1,11) ;," (",BARCAT,")" R ASD
...I $G(BARDBG) W ?23,"A/R RSN:",$E(BARREAS,1,27)
...I $G(BARDBG) W ?60,"ADJ:",$J($FN(BARAMT,",",2),15)
... I BARCATN=21 Q ;PENDING 3/5/14 P.OTT HEAT151948
... I BARCATN=22 Q ;GEN INFO P.OTT HEAT151948
...S BARADJ=BARADJ+BARAMT
...S ALLADJ=ALLADJ+BARAMT
..S BARTOT=BARPAY+BARADJ
..I $G(BARDBG) W !,?28,"BILL BALANCE IF ERA CLAIM IS POSTED: ",$J($FN(BARBAL-BARTOT,",",2),14)
.. ;---chk for neg bal
..I BARBAL-BARTOT<0 D
...Q:BARSTAT'="M"!($D(ERRORS("DUPB"))) ;don't put error on claim if not matched or if duplicate bills bar*1.8*20 REQ5
...I '$$IHSNEGB^BARUFUT(DUZ(2)) Q ;P.OTT 2/5 2014 HEAT147572
...S ERRORS("NEGR")=""
..I $D(ERRORS) D
...S TCLMDA=""
...F S TCLMDA=$O(^BAREDI("I",DUZ(2),IMPDA,30,"B",BARBILL,TCLMDA)) Q:TCLMDA="" D
.... I $$DONOTPR(IMPDA,CLMDA) Q
.... ;Q:$$OVERIDE^BAREDEP1(TCLMDA) ;MRS:BAR*1.8*10 D159-1 AND 2
.... ;Q:$P($G(^BAREDI("I",DUZ(2),IMPDA,30,TCLMDA,0)),U,2)="P" ;DON'T PROCESS POSTED CLAIMS
.... ;S CLSTATUS=$P($P($G(^BAREDI("I",DUZ(2),IMPDA,30,TCLMDA,0)),U,11)," ") ;E-CLAIM STATUS CODE (CLP02) BAR*1.8*6 IM29637
.... ;I CLSTATUS="" S CLSTATUS=$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,2)),U,4) ;MRS:BAR*1.8*10
.... ;Q:(U_"1"_U_"2"_U_"3"_U_"4"_U_"19"_U_"20"_U_"21"_U_"22"_U)'[(U_CLSTATUS_U) ;ADDED 4 (DENIALS) PER EMAIL/CONVERSATION WITH ADRIAN 7/31
....D ADDREAS^BAREDP04(IMPDA,TCLMDA,.ERRORS)
..K ERRORS
.;end new code
.;;
D CHECKTOT(.CHECKTOT) ;CHECK ERA CHECK TOTALS AGAINST BATCH/ITEM TOTAL
Q
;
CHECKTOT(CHECKTOT) ;CHECK ERA CHECK TOTALS AGAINST BATCH/ITEM TOTAL
N ERRORS,CLMDA,ALLPAY,ERACHECK,CLSTATUS
N BPR02 ;BAR*1.8*6 SCR119 IHS/SD/TPF
S ERACHECK=""
;start new code bar*1.8*20 REQ4
W !
W !?2," Matched Bills: ",$J(+$G(BARCNT("MATCHED")),5)," for $",$J($FN(+$G(BARAMT("MATCHED")),",",2),12)
W !?2,"Unmatched Bills: ",$J(+$G(BARCNT("UNMATCHED")),5)," for $",$J($FN(+$G(BARAMT("UNMATCHED")),",",2),12)
W !?2," Total Bills: ",$J(+$G(BARTOT("CNT")),5)," for $",$J($FN(+$G(BARTOT("AMT")),",",2),12)
W !
;end new code REQ4
F S ERACHECK=$O(CHECKTOT(ERACHECK)) Q:ERACHECK="" D
.S CLMDA=""
.S CLMDA=$O(^BAREDI("I",DUZ(2),"F",ERACHECK,IMPDA,CLMDA))
.S BPR02=+$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,2)),U,5) ;BPR MONETARY AMOUNT BAR*1.8*6 SCR119 IHS/SD/TPF
.I $G(BARDBG) W !?2,"CHECKING ERA CHECK TOTALS FOR ",ERACHECK," TOTAL ",$J($FN(CHECKTOT(ERACHECK),",",2),15) ;bar*1.8*20 REQ4
.;
.D GETITMTO(ERACHECK,CHECKTOT(ERACHECK),.ERRORS,BPR02) ;GET BATCH/ITEM TOTAL BAR*1.8*6 SCR119 IHS/SD/TPF
.I $D(ERRORS) D
..S CLMDA=""
..F S CLMDA=$O(^BAREDI("I",DUZ(2),"F",ERACHECK,IMPDA,CLMDA)) Q:CLMDA="" D
... I $$DONOTPR(IMPDA,CLMDA) Q
... ;Q:$$OVERIDE^BAREDEP1(CLMDA) ;MRS:BAR*1.8*10 D159-1 AND 2
... ;Q:$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,2)="P" ;DON'T PROCESS POSTED CLAIMS
... ;S CLSTATUS=$P($P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,11)," ") ;E-CLAIM STATUS CODE (CLP02) BAR*1.8*6 IM29637
... ;I CLSTATUS="" S CLSTATUS=$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,2)),U,4) ;MRS:BAR*1.8*10
... ;Q:(U_"1"_U_"2"_U_"3"_U_"4"_U_"19"_U_"20"_U_"21"_U_"22"_U)'[(U_CLSTATUS_U) ;ADDED 4 (DENIALS) PER EMAIL/CONVERSATION WITH ADRIAN 7/31
... D ADDREAS^BAREDP04(IMPDA,CLMDA,.ERRORS)
.K ERRORS
Q
;
GETIEN(BARX,BARBILL) ;EP - FIND AR BILL IEN
N BARTMP
S (BARBIEN,BARCNT)=0
I '$D(^BARBL(DUZ(2),"B",BARBILL)) S BARX="G" ; Pharmacy POS
F S BARBIEN=$O(^BARBL(DUZ(2),BARX,BARBILL,BARBIEN)) Q:'+BARBIEN D
. S BARCNT=BARCNT+1
. S BARTMP(BARBIEN)=""
I BARCNT=0 Q "BILL NOT FOUND" ;BILL NOT FOUND IN RPMS
I BARCNT>1 Q "DUPLICATE BILLS FOUND" ;DUPES FOUND
S BARBIEN=$O(BARTMP(""))
Q BARBIEN
;
GETITMTO(ERACHECK,ERATOTAL,ERRORS,BRP02) ;EP - GIVEN ERACHECK GET BATCH ITEM TOTALS FOR ERA CHECK ;BAR*1.8*6 SCR119 IHS/SD/TPF
N BARCOLDA,BARITMDA,ITEMTOT,BARXCHK,BARTODAY,%H ;P.OTT
S X=DT D H^%DTC ;GET $H-FORMAT
S BARTODAY=%H
S BARXCHK=$$BARXCHK^BAREDP09(ERACHECK) ;P.OTT
S BARCOLDA=$O(^BARCOL(DUZ(2),"D",BARXCHK,""))
I 'BARCOLDA,(BPR02=0) Q ;BAR*1.8*6 SCR119 DON'T REQUIRE A BATCH NONPAY CHECK FOR A BPR02=0 IHS/SD/TPF
I 'BARCOLDA D Q
. S ERRORS("NB")="" ;NO BATCH FOUND FOR ERA CHECK
. I $G(BARDBG) W !,"NO BATCH FOUND FOR ERA CHECK"
W !
S BPOSTBAL=0 ;BATCH POSTING BALANCE
S BARCOLDA="" F S BARCOLDA=$O(^BARCOL(DUZ(2),"D",BARXCHK,BARCOLDA)) Q:BARCOLDA="" D
. NEW X,BARCBDT,BARCB ;P.OTT
. S BARCB=$$GET1^DIQ(90051.01,BARCOLDA_",",.01,"A")
. S X=$$GET1^DIQ(90051.01,BARCOLDA_",",4,"I")
. D H^%DTC ;GET $H-FORMAT
. S BARCBDT=%H
. IF BARTODAY-BARCBDT>365 D Q ;
. ;;;. S BARMSG="IGNORING COLL. BATCH "_BARCB_" EIN# "_BARCOLDA_" TOO OLD: ("_X_")"
. ;;;. I $G(BARDBG) W !,BARMSG
. ;
. I $G(BARDBG) W !,?2,"CHECKING BATCH: ",BARCB ;SHOW ONLY 'NEW' CB 10/10/2013
. S BPOSTBAL=BPOSTBAL+$$GET1^DIQ(90051.01,BARCOLDA_",",17,"E") ;BAR*1.8*6 LOOK AT BATCH POSTING TOTAL NOT ITEM CREDIT TOTALS
. I $G(BARDBG) W " POSTING BALANCE: ",BPOSTBAL
I ERATOTAL>BPOSTBAL D
. I '$$IHSNEGB^BARUFUT(DUZ(2)) Q ;P.OTT 2/6 2014 HEAT147572
. S ERRORS("ERA > ITM")="" ;ERA TOTAL GREATER THAN BATCH/ITEM TOTAL
. I $G(BARDBG) D ;P.OTT
. . W !,"ERA TOTAL PAYMENTS AND ADJUSTMENTS OF ",ERATOTAL
. . W !,"IS GREATER THAN BATCH POSTING BALANCE OF ",BPOSTBAL
Q
DONOTPR(IMPDA,CLMDA) ;CALLED FROM 3 DIFFERENT PLACES
N CLSTATUS
I $$OVERIDE^BAR50EP1(CLMDA) Q 1 ;MRS:BAR*1.8*10 D159-1 AND 2
I $P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,2)="P" Q 2 ;DON'T PROCESS POSTED CLAIMS
S CLSTATUS=$P($P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,11)," ") ;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 (U_"1"_U_"2"_U_"3"_U_"4"_U_"19"_U_"20"_U_"21"_U_"22"_U)'[(U_CLSTATUS_U) Q 3 ;ADDED 4 (DENIALS) PER EMAIL OF 7/31
;DENIAL ADJUSTMENTS CLP02=4 WERE CREATING NEGATIVE BALANCES
Q 0
;EOR
BAREDEB ; IHS/SD/TPF - AR ERA BALANCE CHECKER ; 01/28/2009
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**5,6,10,20,22,23,24**;OCT 26,2005;Build 69
+2 ;
+3 ;THIS RTN CONTAINS THE BALANCE CHECKING NEED SO ERA POSTING DOES NOT ALLOW
+4 ;POSTING WHICH WILL NOT BE ACCEPTED BY UFMS
+5 ;
+6 ;BATCH - CHECKS THE TRANSACTIONS WITHIN A SINGLE ERA FILE BEING POSTED
+7 ;AGAINST A BATCH. THE PAYMENTS/ADJUSTMENTS FROM THE ERA FILE MUST BE <= THE
+8 ;BATCH AMOUNT (#29) AND THE BATCH AMOUNT (#29) MUST BE >=0
+9 ;
+10 ;IHS/SD/POT HEAT82698 NOV 2012 LEADING ZEROES IN CHKECK # (POS) - BAR 1.8*23
+11 ;; MAR 2013 EXCLUDED COL BATCHES OLDER THAN 365 DAYS
+12 ;IHS/SD/POT HEAT147572 2/5/2014 ALLOW TRIBAL SITES ERA POSTING OF NEG BAL & CANCELLED BILLS - BAR 1.8*24
+13 ;IHS/SD/POT HEAT151948 2/6/2014 FIXED PENDING ADJ. (NEGATIVE BILL BALANCE)- BAR 1.8*24
+14 QUIT
+15 ;
+16 ;TYPE = "ERA" FOR INTERNAL ERA FILE CHECK, RPMS = COMPARE ERA TO RPMS BILL
NEGBAL(IMPDA,TYPE) ;EP - CHECK FOR NEGATIVE BALANCE W/IN ERA AND IF POSTED AGAINST RPMS
+1 IF $GET(TYPE)=""
QUIT
+2 IF $GET(BARDBG)
WRITE !!!,"CHECKING FOR NEGATIVE BALANCE IF MATCHED ERA CLAIMS ARE POSTED..."
+3 NEW BARBILL,BARANS,BARTOT,BARPAY,BARADJ,ADJDA,ERRORS,CHECKTOT,ALLADJ
+4 NEW ERACHECK,CLMDA,TCLMDA,CLM,ERRORS,BILLCHOS,BARTYPE,BARREAS
+5 SET (BARBAL,BARTOT,ALLADJ)=0
+6 KILL CHECKTOT
+7 SET BARBILL=""
+8 ;bar*1.8*20
KILL BARCNT,BARAMT,BARTOT
+9 SET CLMCNT=0
+10 SET CLMDA=0
+11 KILL ^XTMP("BAR-LIST",$JOB,DUZ(2))
+12 FOR
SET CLMDA=$ORDER(^BAREDI("I",DUZ(2),"F",BARCHK,IMPDA,CLMDA))
IF 'CLMDA
QUIT
Begin DoDot:1
+13 SET BARBILL=$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U)
+14 SET ^XTMP("BAR-LIST",$JOB,DUZ(2),BARBILL,CLMDA)=""
End DoDot:1
+15 SET BARBILL=""
+16 FOR
SET BARBILL=$ORDER(^XTMP("BAR-LIST",$JOB,DUZ(2),BARBILL))
IF BARBILL=""
QUIT
Begin DoDot:1
+17 ;S CLMCNT=+$G(CLMCNT)+1 ;bar*1.8*20 REQ4 ;bar*1.8*22 SDR
+18 SET BARPAY=0
+19 SET CLMDA=0
SET BILLCHOS=""
+20 FOR
SET CLMDA=$ORDER(^BAREDI("I",DUZ(2),IMPDA,30,"B",BARBILL,CLMDA))
IF 'CLMDA
QUIT
Begin DoDot:2
+21 SET CLMCNT=CLMCNT+1
+22 SET (BARTOT,BARADJ,BARPAY)=0
+23 ;A-CLAIM ; IF THIS IS POPULATED THEN THE CORRCET BILL WAS FOUND OR CHOSEN ALREADY
SET BILLCHOS=$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,1)),U)
+24 ;bar*1.8*20 REQ5
SET BARSTAT=$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,2)
+25 ;bar*1.8*20
SET BARTOT("CNT")=+$GET(BARTOT("CNT"))+1
SET BARTOT("AMT")=+$GET(BARTOT("AMT"))+$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,4)
+26 ;bar*1.8*20
IF BARSTAT="M"
SET BARCNT("MATCHED")=+$GET(BARCNT("MATCHED"))+1
SET BARAMT("MATCHED")=+$GET(BARAMT("MATCHED"))+$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,4)
+27 ;bar*1.8*20
IF BARSTAT'="M"
SET BARCNT("UNMATCHED")=+$GET(BARCNT("UNMATCHED"))+1
SET BARAMT("UNMATCHED")=+$GET(BARAMT("UNMATCHED"))+$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,4)
+28 ;only display matched claims bar*1.8*20
IF BARSTAT'="M"
QUIT
+29 ;bar*1.8*20 REQ4
IF $GET(BARDBG)
WRITE !!,CLMCNT,?4,"ERA BILL: ",BARBILL
+30 IF BILLCHOS
SET BARBLIEN=BILLCHOS
+31 IF '$TEST
SET BARBLIEN=$$GETIEN("B",BARBILL)
+32 IF BARBLIEN="BILL NOT FOUND"
Begin DoDot:3
+33 ;S CLMDA=$O(^BAREDI("I",DUZ(2),IMPDA,30,"B",BARBILL,""))
+34 IF '$DATA(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,4,"B",11))
Begin DoDot:4
+35 ;BILL NOT FOUND IN RPMS. SET ONLY IF OLD ERROR 11 NOT SET
SET ERRORS("BL NF")=""
End DoDot:4
End DoDot:3
+36 IF BARBLIEN="DUPLICATE BILLS FOUND"
Begin DoDot:3
+37 ;DUPLICATE BILLS FOUND IN RPMS
SET ERRORS("DUPB")=""
End DoDot:3
+38 ;CURRENT BILL AMOUNT
IF BARBLIEN
SET BARBAL=$$GET1^DIQ(90050.01,BARBLIEN_",",15,"I")
+39 IF '$TEST
SET BARBAL=0
+40 ;bar*1.8*20 REQ4
IF $GET(BARDBG)
WRITE ?41,"CURRENT BILL AMT(RPMS): ",$JUSTIFY($FNUMBER(BARBAL,",",2),14)
+41 ;
+42 SET BARADJ=0
+43 IF $$DONOTPR(IMPDA,CLMDA)
QUIT
+44 ;Q:$$OVERIDE^BAR50EP1(CLMDA) ;MRS:BAR*1.8*10 D159-1 AND 2
+45 ;Q:$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,2)="P" ;DON'T PROCESS POSTED CLAIMS
+46 ;S CLSTATUS=$P($P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,11)," ") ;E-CLAIM STATUS CODE (CLP02)
+47 ;I CLSTATUS="" S CLSTATUS=$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,2)),U,4) ;MRS:BAR*1.8*10 H2555
+48 ;Q:(U_"1"_U_"2"_U_"3"_U_"4"_U_"19"_U_"20"_U_"21"_U_"22"_U)'[(U_CLSTATUS_U) ;ADDED 4 (DENIALS) PER EMAIL OF 7/31
+49 ;DENIAL ADJUSTMENTS CLP02=4 WERE CREATING NEGATIVE BALANCES
+50 SET ERACHECK=$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,2)),U)
+51 SET BARAMT=$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,4)
+52 SET BARPAY=BARPAY+BARAMT
+53 ;bar*1.8*20 REQ4
IF $GET(BARDBG)
WRITE !?3,$SELECT(BARBILL'=$$GET1^DIQ(90050.01,BILLCHOS,".01"):"("_$$GET1^DIQ(90050.01,BILLCHOS,".01")_")",1:""),?59,"PYMT: ",$JUSTIFY($FNUMBER(BARAMT,",",2),14)
+54 ;
+55 SET CHECKTOT(ERACHECK)=$GET(CHECKTOT(ERACHECK))+BARAMT
+56 SET ADJDA=0
+57 FOR
SET ADJDA=$ORDER(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,30,ADJDA))
IF '+ADJDA
QUIT
Begin DoDot:3
+58 SET BARAMT=$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,30,ADJDA,0)),U,2)
+59 SET BARCAT=$$GET1^DIQ(90056.0208,ADJDA_","_CLMDA_","_IMPDA_",",.04,"E")
+60 ;P.OTT 2/6/2014 HEAT151948
SET BARCATN=$$GET1^DIQ(90056.0208,ADJDA_","_CLMDA_","_IMPDA_",",.04,"I")
+61 SET BARREAS=$$GET1^DIQ(90056.0208,ADJDA_","_CLMDA_","_IMPDA_",",.05,"E")
+62 ;," (",BARCAT,")" R ASD
IF $GET(BARDBG)
WRITE !?3,"A/R CAT:",$EXTRACT(BARCAT,1,11)
+63 IF $GET(BARDBG)
WRITE ?23,"A/R RSN:",$EXTRACT(BARREAS,1,27)
+64 IF $GET(BARDBG)
WRITE ?60,"ADJ:",$JUSTIFY($FNUMBER(BARAMT,",",2),15)
+65 ;PENDING 3/5/14 P.OTT HEAT151948
IF BARCATN=21
QUIT
+66 ;GEN INFO P.OTT HEAT151948
IF BARCATN=22
QUIT
+67 SET BARADJ=BARADJ+BARAMT
+68 SET ALLADJ=ALLADJ+BARAMT
End DoDot:3
+69 SET BARTOT=BARPAY+BARADJ
+70 IF $GET(BARDBG)
WRITE !,?28,"BILL BALANCE IF ERA CLAIM IS POSTED: ",$JUSTIFY($FNUMBER(BARBAL-BARTOT,",",2),14)
+71 ;---chk for neg bal
+72 IF BARBAL-BARTOT<0
Begin DoDot:3
+73 ;don't put error on claim if not matched or if duplicate bills bar*1.8*20 REQ5
IF BARSTAT'="M"!($DATA(ERRORS("DUPB")))
QUIT
+74 ;P.OTT 2/5 2014 HEAT147572
IF '$$IHSNEGB^BARUFUT(DUZ(2))
QUIT
+75 SET ERRORS("NEGR")=""
End DoDot:3
+76 IF $DATA(ERRORS)
Begin DoDot:3
+77 SET TCLMDA=""
+78 FOR
SET TCLMDA=$ORDER(^BAREDI("I",DUZ(2),IMPDA,30,"B",BARBILL,TCLMDA))
IF TCLMDA=""
QUIT
Begin DoDot:4
+79 IF $$DONOTPR(IMPDA,CLMDA)
QUIT
+80 ;Q:$$OVERIDE^BAREDEP1(TCLMDA) ;MRS:BAR*1.8*10 D159-1 AND 2
+81 ;Q:$P($G(^BAREDI("I",DUZ(2),IMPDA,30,TCLMDA,0)),U,2)="P" ;DON'T PROCESS POSTED CLAIMS
+82 ;S CLSTATUS=$P($P($G(^BAREDI("I",DUZ(2),IMPDA,30,TCLMDA,0)),U,11)," ") ;E-CLAIM STATUS CODE (CLP02) BAR*1.8*6 IM29637
+83 ;I CLSTATUS="" S CLSTATUS=$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,2)),U,4) ;MRS:BAR*1.8*10
+84 ;Q:(U_"1"_U_"2"_U_"3"_U_"4"_U_"19"_U_"20"_U_"21"_U_"22"_U)'[(U_CLSTATUS_U) ;ADDED 4 (DENIALS) PER EMAIL/CONVERSATION WITH ADRIAN 7/31
+85 DO ADDREAS^BAREDP04(IMPDA,TCLMDA,.ERRORS)
End DoDot:4
End DoDot:3
+86 KILL ERRORS
End DoDot:2
+87 ;end new code
+88 ;;
End DoDot:1
+89 ;CHECK ERA CHECK TOTALS AGAINST BATCH/ITEM TOTAL
DO CHECKTOT(.CHECKTOT)
+90 QUIT
+91 ;
CHECKTOT(CHECKTOT) ;CHECK ERA CHECK TOTALS AGAINST BATCH/ITEM TOTAL
+1 NEW ERRORS,CLMDA,ALLPAY,ERACHECK,CLSTATUS
+2 ;BAR*1.8*6 SCR119 IHS/SD/TPF
NEW BPR02
+3 SET ERACHECK=""
+4 ;start new code bar*1.8*20 REQ4
+5 WRITE !
+6 WRITE !?2," Matched Bills: ",$JUSTIFY(+$GET(BARCNT("MATCHED")),5)," for $",$JUSTIFY($FNUMBER(+$GET(BARAMT("MATCHED")),",",2),12)
+7 WRITE !?2,"Unmatched Bills: ",$JUSTIFY(+$GET(BARCNT("UNMATCHED")),5)," for $",$JUSTIFY($FNUMBER(+$GET(BARAMT("UNMATCHED")),",",2),12)
+8 WRITE !?2," Total Bills: ",$JUSTIFY(+$GET(BARTOT("CNT")),5)," for $",$JUSTIFY($FNUMBER(+$GET(BARTOT("AMT")),",",2),12)
+9 WRITE !
+10 ;end new code REQ4
+11 FOR
SET ERACHECK=$ORDER(CHECKTOT(ERACHECK))
IF ERACHECK=""
QUIT
Begin DoDot:1
+12 SET CLMDA=""
+13 SET CLMDA=$ORDER(^BAREDI("I",DUZ(2),"F",ERACHECK,IMPDA,CLMDA))
+14 ;BPR MONETARY AMOUNT BAR*1.8*6 SCR119 IHS/SD/TPF
SET BPR02=+$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,2)),U,5)
+15 ;bar*1.8*20 REQ4
IF $GET(BARDBG)
WRITE !?2,"CHECKING ERA CHECK TOTALS FOR ",ERACHECK," TOTAL ",$JUSTIFY($FNUMBER(CHECKTOT(ERACHECK),",",2),15)
+16 ;
+17 ;GET BATCH/ITEM TOTAL BAR*1.8*6 SCR119 IHS/SD/TPF
DO GETITMTO(ERACHECK,CHECKTOT(ERACHECK),.ERRORS,BPR02)
+18 IF $DATA(ERRORS)
Begin DoDot:2
+19 SET CLMDA=""
+20 FOR
SET CLMDA=$ORDER(^BAREDI("I",DUZ(2),"F",ERACHECK,IMPDA,CLMDA))
IF CLMDA=""
QUIT
Begin DoDot:3
+21 IF $$DONOTPR(IMPDA,CLMDA)
QUIT
+22 ;Q:$$OVERIDE^BAREDEP1(CLMDA) ;MRS:BAR*1.8*10 D159-1 AND 2
+23 ;Q:$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,2)="P" ;DON'T PROCESS POSTED CLAIMS
+24 ;S CLSTATUS=$P($P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,11)," ") ;E-CLAIM STATUS CODE (CLP02) BAR*1.8*6 IM29637
+25 ;I CLSTATUS="" S CLSTATUS=$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,2)),U,4) ;MRS:BAR*1.8*10
+26 ;Q:(U_"1"_U_"2"_U_"3"_U_"4"_U_"19"_U_"20"_U_"21"_U_"22"_U)'[(U_CLSTATUS_U) ;ADDED 4 (DENIALS) PER EMAIL/CONVERSATION WITH ADRIAN 7/31
+27 DO ADDREAS^BAREDP04(IMPDA,CLMDA,.ERRORS)
End DoDot:3
End DoDot:2
+28 KILL ERRORS
End DoDot:1
+29 QUIT
+30 ;
GETIEN(BARX,BARBILL) ;EP - FIND AR BILL IEN
+1 NEW BARTMP
+2 SET (BARBIEN,BARCNT)=0
+3 ; Pharmacy POS
IF '$DATA(^BARBL(DUZ(2),"B",BARBILL))
SET BARX="G"
+4 FOR
SET BARBIEN=$ORDER(^BARBL(DUZ(2),BARX,BARBILL,BARBIEN))
IF '+BARBIEN
QUIT
Begin DoDot:1
+5 SET BARCNT=BARCNT+1
+6 SET BARTMP(BARBIEN)=""
End DoDot:1
+7 ;BILL NOT FOUND IN RPMS
IF BARCNT=0
QUIT "BILL NOT FOUND"
+8 ;DUPES FOUND
IF BARCNT>1
QUIT "DUPLICATE BILLS FOUND"
+9 SET BARBIEN=$ORDER(BARTMP(""))
+10 QUIT BARBIEN
+11 ;
GETITMTO(ERACHECK,ERATOTAL,ERRORS,BRP02) ;EP - GIVEN ERACHECK GET BATCH ITEM TOTALS FOR ERA CHECK ;BAR*1.8*6 SCR119 IHS/SD/TPF
+1 ;P.OTT
NEW BARCOLDA,BARITMDA,ITEMTOT,BARXCHK,BARTODAY,%H
+2 ;GET $H-FORMAT
SET X=DT
DO H^%DTC
+3 SET BARTODAY=%H
+4 ;P.OTT
SET BARXCHK=$$BARXCHK^BAREDP09(ERACHECK)
+5 SET BARCOLDA=$ORDER(^BARCOL(DUZ(2),"D",BARXCHK,""))
+6 ;BAR*1.8*6 SCR119 DON'T REQUIRE A BATCH NONPAY CHECK FOR A BPR02=0 IHS/SD/TPF
IF 'BARCOLDA
IF (BPR02=0)
QUIT
+7 IF 'BARCOLDA
Begin DoDot:1
+8 ;NO BATCH FOUND FOR ERA CHECK
SET ERRORS("NB")=""
+9 IF $GET(BARDBG)
WRITE !,"NO BATCH FOUND FOR ERA CHECK"
End DoDot:1
QUIT
+10 WRITE !
+11 ;BATCH POSTING BALANCE
SET BPOSTBAL=0
+12 SET BARCOLDA=""
FOR
SET BARCOLDA=$ORDER(^BARCOL(DUZ(2),"D",BARXCHK,BARCOLDA))
IF BARCOLDA=""
QUIT
Begin DoDot:1
+13 ;P.OTT
NEW X,BARCBDT,BARCB
+14 SET BARCB=$$GET1^DIQ(90051.01,BARCOLDA_",",.01,"A")
+15 SET X=$$GET1^DIQ(90051.01,BARCOLDA_",",4,"I")
+16 ;GET $H-FORMAT
DO H^%DTC
+17 SET BARCBDT=%H
+18 ;
IF BARTODAY-BARCBDT>365
Begin DoDot:2
End DoDot:2
QUIT
+19 ;;;. S BARMSG="IGNORING COLL. BATCH "_BARCB_" EIN# "_BARCOLDA_" TOO OLD: ("_X_")"
+20 ;;;. I $G(BARDBG) W !,BARMSG
+21 ;
+22 ;SHOW ONLY 'NEW' CB 10/10/2013
IF $GET(BARDBG)
WRITE !,?2,"CHECKING BATCH: ",BARCB
+23 ;BAR*1.8*6 LOOK AT BATCH POSTING TOTAL NOT ITEM CREDIT TOTALS
SET BPOSTBAL=BPOSTBAL+$$GET1^DIQ(90051.01,BARCOLDA_",",17,"E")
+24 IF $GET(BARDBG)
WRITE " POSTING BALANCE: ",BPOSTBAL
End DoDot:1
+25 IF ERATOTAL>BPOSTBAL
Begin DoDot:1
+26 ;P.OTT 2/6 2014 HEAT147572
IF '$$IHSNEGB^BARUFUT(DUZ(2))
QUIT
+27 ;ERA TOTAL GREATER THAN BATCH/ITEM TOTAL
SET ERRORS("ERA > ITM")=""
+28 ;P.OTT
IF $GET(BARDBG)
Begin DoDot:2
+29 WRITE !,"ERA TOTAL PAYMENTS AND ADJUSTMENTS OF ",ERATOTAL
+30 WRITE !,"IS GREATER THAN BATCH POSTING BALANCE OF ",BPOSTBAL
End DoDot:2
End DoDot:1
+31 QUIT
DONOTPR(IMPDA,CLMDA) ;CALLED FROM 3 DIFFERENT PLACES
+1 NEW CLSTATUS
+2 ;MRS:BAR*1.8*10 D159-1 AND 2
IF $$OVERIDE^BAR50EP1(CLMDA)
QUIT 1
+3 ;DON'T PROCESS POSTED CLAIMS
IF $PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,2)="P"
QUIT 2
+4 ;E-CLAIM STATUS CODE (CLP02)
SET CLSTATUS=$PIECE($PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,11)," ")
+5 ;MRS:BAR*1.8*10 H2555
IF CLSTATUS=""
SET CLSTATUS=$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,2)),U,4)
+6 ;ADDED 4 (DENIALS) PER EMAIL OF 7/31
IF (U_"1"_U_"2"_U_"3"_U_"4"_U_"19"_U_"20"_U_"21"_U_"22"_U)'[(U_CLSTATUS_U)
QUIT 3
+7 ;DENIAL ADJUSTMENTS CLP02=4 WERE CREATING NEGATIVE BALANCES
+8 QUIT 0
+9 ;EOR
