BAR50EB ; IHS/SD/TPF - AR ERA BALANCE CHECKER ; 01/28/2009
;;1.8;IHS ACCOUNTS RECEIVABLE;**5,6,10,20,21,22,23,24,26,28**;OCT 26,2005;Build 92
;
;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
;;P.OTTIS HEAT#82698 NOV 2012 LEADING ZEROES IN CHKECK # (POS)
;; MAR 2013 EXCLUDED COL BATCHES OLDER THAN 365 DAYS
;; 10/10/2013 FIXED ERR MSG
;;HEAT147572 P.OTT ALLOW TRIBAL SITES ERA POSTING OF NEG BAL & CANCELLED BILLS 2/5/2014
;;HEAT151948 P.OTT 2/6/2014 FIXED PENDING ADJ. (NEGATIVE BILL BALANCE)
;IHS/SD/SDR 1.8*26 - HEAT170856 Changed IHSNEGB to IHSCANCB for ERA > ITM check.
;IHS/SD/SDR 1.8*28 - CR8346 HEAT275351 - Fixed so matched with reason NTP won't get counted in matched total.
;IHS/DIT/CPC 1.8*28 - CR9372 Change position of ADDREAS
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..." ;bar*1.8*20
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
.S BARPAY=0
.;WAS A BILL CHOSEN OR MATCHED EARLIER IN BAR50P04?
.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
...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 ;new code
..;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 ;bar*1.8*28 IHS/SD/SDR CR8346 HEAT275351
..I ((BARSTAT="M")&(+$O(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,4,0))=0)) S CHECKTOT(ERACHECK)=$G(CHECKTOT(ERACHECK))+BARAMT ;only count postable amounts ;bar*1.8*28 IHS/SD/SDR CR8346 HEAT275351
..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 ((BARSTAT="M")&(+$O(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,4,0))'=0)) Q ;bar*1.8*28 IHS/SD/SDR CR8346 HEAT275351
..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 ADDREAS^BAR50P04(IMPDA,CLMDA,.ERRORS) ;IHS/DIT/CPC 1.8*28 - Move out of loop
...;S TCLMDA=""
...;F S TCLMDA=$O(^BAREDI("I",DUZ(2),IMPDA,30,"B",BARBILL,TCLMDA)) Q:TCLMDA="" D
....;I $$DONOTPR(IMPDA,CLMDA) Q ;new code
....;Q:$$OVERIDE^BAR50EP1(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^BAR50P04(IMPDA,TCLMDA,.ERRORS)
..K ERRORS
..; ------
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
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 !
S ERACHECK="" 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 ;new code
... ;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) 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^BAR50P04(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
;
XGETIEN(BARX,BARBILL) ;NEW CODEEP - FIND AR BILL IEN 12/10/2013
N BARTMP,BARXBILL,BARRET
S BARRET=""
S BARX="G",BARXBILL=BARBILL
I $D(^BARBL(DUZ(2),BARX,BARXBILL)) S BARRET=$$GETIT() Q BARRET
S BARX="G",BARXBILL=+BARBILL
I $D(^BARBL(DUZ(2),BARX,BARXBILL)) S BARRET=$$GETIT() Q BARRET
S BARX="B",BARXBILL=BARBILL
I $D(^BARBL(DUZ(2),BARX,BARXBILL)) S BARRET=$$GETIT() Q BARRET
S BARX="B",BARXBILL=+BARBILL
I $D(^BARBL(DUZ(2),BARX,BARXBILL)) S BARRET=$$GETIT() Q BARRET
Q BARRET
GETIT() N BARBIEN
S BARCNT=0
S BARBIEN=0 F S BARBIEN=$O(^BARBL(DUZ(2),BARX,BARXBILL,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 ;%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 ;DONT SHOW THIS MSG: 10/10/2013
.;;;. S BARMSG="IGNORING COLL. BATCH "_BARCB_" EIN# "_BARCOLDA_" TOO OLD: ("_X_")"
.;;;. I $G(BARDBG) W !,BARMSG
.;
.I $G(BARDBG) W !,?2,"CHECKING BATCH: ",BARCB ;P.OTT 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 ;
..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 - IHS/DIT/CPC 1.8*28
BAR50EB ; IHS/SD/TPF - AR ERA BALANCE CHECKER ; 01/28/2009
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**5,6,10,20,21,22,23,24,26,28**;OCT 26,2005;Build 92
+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 ;;P.OTTIS HEAT#82698 NOV 2012 LEADING ZEROES IN CHKECK # (POS)
+10 ;; MAR 2013 EXCLUDED COL BATCHES OLDER THAN 365 DAYS
+11 ;; 10/10/2013 FIXED ERR MSG
+12 ;;HEAT147572 P.OTT ALLOW TRIBAL SITES ERA POSTING OF NEG BAL & CANCELLED BILLS 2/5/2014
+13 ;;HEAT151948 P.OTT 2/6/2014 FIXED PENDING ADJ. (NEGATIVE BILL BALANCE)
+14 ;IHS/SD/SDR 1.8*26 - HEAT170856 Changed IHSNEGB to IHSCANCB for ERA > ITM check.
+15 ;IHS/SD/SDR 1.8*28 - CR8346 HEAT275351 - Fixed so matched with reason NTP won't get counted in matched total.
+16 ;IHS/DIT/CPC 1.8*28 - CR9372 Change position of ADDREAS
+17 QUIT
+18 ;
+19 ;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 ;bar*1.8*20
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 ;bar*1.8*20 REQ4
SET CLMCNT=+$GET(CLMCNT)+1
+18 SET BARPAY=0
+19 ;WAS A BILL CHOSEN OR MATCHED EARLIER IN BAR50P04?
+20 SET CLMDA=0
SET BILLCHOS=""
+21 FOR
SET CLMDA=$ORDER(^BAREDI("I",DUZ(2),IMPDA,30,"B",BARBILL,CLMDA))
IF 'CLMDA
QUIT
Begin DoDot:2
+22 SET CLMCNT=CLMCNT+1
+23 SET (BARTOT,BARADJ,BARPAY)=0
+24 ;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)
+25 ;bar*1.8*20 REQ5
SET BARSTAT=$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,2)
+26 ;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)
+27 ;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)
+28 ;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)
+29 ;only display matched claims bar*1.8*20
IF BARSTAT'="M"
QUIT
+30 ;bar*1.8*20 REQ4
IF $GET(BARDBG)
WRITE !!,CLMCNT,?4,"ERA BILL: ",BARBILL
+31 IF BILLCHOS
SET BARBLIEN=BILLCHOS
+32 IF '$TEST
SET BARBLIEN=$$GETIEN("B",BARBILL)
+33 IF BARBLIEN="BILL NOT FOUND"
Begin DoDot:3
+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 ;new code
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 ;S CHECKTOT(ERACHECK)=$G(CHECKTOT(ERACHECK))+BARAMT ;bar*1.8*28 IHS/SD/SDR CR8346 HEAT275351
+56 ;only count postable amounts ;bar*1.8*28 IHS/SD/SDR CR8346 HEAT275351
IF ((BARSTAT="M")&(+$ORDER(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,4,0))=0))
SET CHECKTOT(ERACHECK)=$GET(CHECKTOT(ERACHECK))+BARAMT
+57 SET ADJDA=0
+58 FOR
SET ADJDA=$ORDER(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,30,ADJDA))
IF '+ADJDA
QUIT
Begin DoDot:3
+59 SET BARAMT=$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,30,ADJDA,0)),U,2)
+60 SET BARCAT=$$GET1^DIQ(90056.0208,ADJDA_","_CLMDA_","_IMPDA_",",.04,"E")
+61 ;P.OTT 2/6/2014 HEAT151948
SET BARCATN=$$GET1^DIQ(90056.0208,ADJDA_","_CLMDA_","_IMPDA_",",.04,"I")
+62 SET BARREAS=$$GET1^DIQ(90056.0208,ADJDA_","_CLMDA_","_IMPDA_",",.05,"E")
+63 ;," (",BARCAT,")" R ASD
IF $GET(BARDBG)
WRITE !?3,"A/R CAT:",$EXTRACT(BARCAT,1,11)
+64 IF $GET(BARDBG)
WRITE ?23,"A/R RSN:",$EXTRACT(BARREAS,1,27)
+65 IF $GET(BARDBG)
WRITE ?60,"ADJ:",$JUSTIFY($FNUMBER(BARAMT,",",2),15)
+66 ;PENDING 3/5/14 P.OTT HEAT151948
IF BARCATN=21
QUIT
+67 ;GEN INFO P.OTT HEAT151948
IF BARCATN=22
QUIT
+68 SET BARADJ=BARADJ+BARAMT
+69 SET ALLADJ=ALLADJ+BARAMT
End DoDot:3
+70 SET BARTOT=BARPAY+BARADJ
+71 IF $GET(BARDBG)
WRITE !,?28,"BILL BALANCE IF ERA CLAIM IS POSTED: ",$JUSTIFY($FNUMBER(BARBAL-BARTOT,",",2),14)
+72 ;---chk for neg bal
+73 ;bar*1.8*28 IHS/SD/SDR CR8346 HEAT275351
IF ((BARSTAT="M")&(+$ORDER(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,4,0))'=0))
QUIT
+74 IF BARBAL-BARTOT<0
Begin DoDot:3
+75 ;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
+76 ;P.OTT 2/5 2014 HEAT147572
IF '$$IHSNEGB^BARUFUT(DUZ(2))
QUIT
+77 SET ERRORS("NEGR")=""
End DoDot:3
+78 ;IHS/DIT/CPC 1.8*28 - Move out of loop
IF $DATA(ERRORS)
DO ADDREAS^BAR50P04(IMPDA,CLMDA,.ERRORS)
+79 ;S TCLMDA=""
+80 ;F S TCLMDA=$O(^BAREDI("I",DUZ(2),IMPDA,30,"B",BARBILL,TCLMDA)) Q:TCLMDA="" D
+81 ;I $$DONOTPR(IMPDA,CLMDA) Q ;new code
+82 ;Q:$$OVERIDE^BAR50EP1(TCLMDA) ;MRS:BAR*1.8*10 D159-1 AND 2
+83 ;Q:$P($G(^BAREDI("I",DUZ(2),IMPDA,30,TCLMDA,0)),U,2)="P" ;DON'T PROCESS POSTED CLAIMS
+84 ;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
+85 ;I CLSTATUS="" S CLSTATUS=$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,2)),U,4) ;MRS:BAR*1.8*10
+86 ;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
+87 ;D ADDREAS^BAR50P04(IMPDA,TCLMDA,.ERRORS)
+88 KILL ERRORS
+89 ; ------
End DoDot:2
End DoDot:1
+90 ;CHECK ERA CHECK TOTALS AGAINST BATCH/ITEM TOTAL
DO CHECKTOT(.CHECKTOT)
+91 QUIT
+92 ;
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 WRITE !
+4 WRITE !?2," Matched Bills: ",$JUSTIFY(+$GET(BARCNT("MATCHED")),5)," for $",$JUSTIFY($FNUMBER(+$GET(BARAMT("MATCHED")),",",2),12)
+5 WRITE !?2,"Unmatched Bills: ",$JUSTIFY(+$GET(BARCNT("UNMATCHED")),5)," for $",$JUSTIFY($FNUMBER(+$GET(BARAMT("UNMATCHED")),",",2),12)
+6 WRITE !?2," Total Bills: ",$JUSTIFY(+$GET(BARTOT("CNT")),5)," for $",$JUSTIFY($FNUMBER(+$GET(BARTOT("AMT")),",",2),12)
+7 WRITE !
+8 SET ERACHECK=""
FOR
SET ERACHECK=$ORDER(CHECKTOT(ERACHECK))
IF ERACHECK=""
QUIT
Begin DoDot:1
+9 SET CLMDA=""
+10 SET CLMDA=$ORDER(^BAREDI("I",DUZ(2),"F",ERACHECK,IMPDA,CLMDA))
+11 ;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)
+12 ;bar*1.8*20 REQ4
IF $GET(BARDBG)
WRITE !?2,"CHECKING ERA CHECK TOTALS FOR ",ERACHECK," TOTAL ",$JUSTIFY($FNUMBER(CHECKTOT(ERACHECK),",",2),15)
+13 ;
+14 ;GET BATCH/ITEM TOTAL BAR*1.8*6 SCR119 IHS/SD/TPF
DO GETITMTO(ERACHECK,CHECKTOT(ERACHECK),.ERRORS,BPR02)
+15 IF $DATA(ERRORS)
Begin DoDot:2
+16 SET CLMDA=""
+17 FOR
SET CLMDA=$ORDER(^BAREDI("I",DUZ(2),"F",ERACHECK,IMPDA,CLMDA))
IF CLMDA=""
QUIT
Begin DoDot:3
+18 ;new code
IF $$DONOTPR(IMPDA,CLMDA)
QUIT
+19 ;Q:$$OVERIDE^BAR50EP1(CLMDA) ;MRS:BAR*1.8*10 D159-1 AND 2
+20 ;Q:$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,2)="P" ;DON'T PROCESS POSTED CLAIMS
+21 ;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
+22 ;I CLSTATUS="" S CLSTATUS=$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,2)),U,4) ;MRS:BAR*1.8*10
+23 ;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
+24 DO ADDREAS^BAR50P04(IMPDA,CLMDA,.ERRORS)
End DoDot:3
End DoDot:2
+25 KILL ERRORS
End DoDot:1
+26 QUIT
+27 ;
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 ;
XGETIEN(BARX,BARBILL) ;NEW CODEEP - FIND AR BILL IEN 12/10/2013
+1 NEW BARTMP,BARXBILL,BARRET
+2 SET BARRET=""
+3 SET BARX="G"
SET BARXBILL=BARBILL
+4 IF $DATA(^BARBL(DUZ(2),BARX,BARXBILL))
SET BARRET=$$GETIT()
QUIT BARRET
+5 SET BARX="G"
SET BARXBILL=+BARBILL
+6 IF $DATA(^BARBL(DUZ(2),BARX,BARXBILL))
SET BARRET=$$GETIT()
QUIT BARRET
+7 SET BARX="B"
SET BARXBILL=BARBILL
+8 IF $DATA(^BARBL(DUZ(2),BARX,BARXBILL))
SET BARRET=$$GETIT()
QUIT BARRET
+9 SET BARX="B"
SET BARXBILL=+BARBILL
+10 IF $DATA(^BARBL(DUZ(2),BARX,BARXBILL))
SET BARRET=$$GETIT()
QUIT BARRET
+11 QUIT BARRET
GETIT() NEW BARBIEN
+1 SET BARCNT=0
+2 SET BARBIEN=0
FOR
SET BARBIEN=$ORDER(^BARBL(DUZ(2),BARX,BARXBILL,BARBIEN))
IF '+BARBIEN
QUIT
Begin DoDot:1
+3 SET BARCNT=BARCNT+1
+4 SET BARTMP(BARBIEN)=""
End DoDot:1
+5 ;BILL NOT FOUND IN RPMS
IF BARCNT=0
QUIT "BILL NOT FOUND"
+6 ;DUPES FOUND
IF BARCNT>1
QUIT "DUPLICATE BILLS FOUND"
+7 SET BARBIEN=$ORDER(BARTMP(""))
+8 QUIT BARBIEN
+9 ;
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 ;S X=DT D H^%DTC ;GET $H-FORMAT
+3 ;%H
SET BARTODAY=+$HOROLOG
+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 ;DONT SHOW THIS MSG: 10/10/2013
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 ;P.OTT 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 ;
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 - IHS/DIT/CPC 1.8*28
