- BAREDP0Z ; IHS/SD/LSL - MATCH REASONS AND CLAIMS ; 01/30/2009
- ;;1.8;IHS ACCOUNTS RECEIVABLE;**10,20,23,24,28**;OCT 26, 2005;Build 92
- ; NEW ROUTINE TO LOCKOUT REVERSALS AND PLB SEGMENTS; MRS:BAR*1.8*10 D159
- ; MODIFIED TO LIMIT LOCK OUT TO INDIVIDUAL CHECKS
- ;IHS/SD/POT HEAT148388 ACCEPT REVERSALS FOR TYPE= 1 IF NEG PAYMENT FIX: 1/24/2014- BAR*1.8*.24
- ;IHS/SD/POT HEAT147572 ALLOW TRIBAL SITES ERA POSTING OF NEG BAL & CANCELLED BILLS- BAR*1.8*.24
- ;IHS/SD/POT check for IHSNEGB moved from top to $$NEGP - BAR*1.8*.24
- ;IHS/DIT/CPC Fix typo CR9572 BAR*1.8*28
- Q
- EN(IMPDA) ; EP ; Scan SEGMENTS for PLB, REVERSALS AND NEGATIVE AMOUNTS
- N BARFLG
- ;old code Q:'$$IHS^BARUFUT(DUZ(2)) 0 ;Ignore if NON-IHS facility
- ;I '$$IHSNEGB^BARUFUT(DUZ(2)) Q 0 ;HEAT147572 line moved to $$NEGP 4/22/2014
- W !!,"Now will look for PLBs, Payment Reversals, and Negative Payments..." ;bar*1.8*20 REQ4
- S BARFLG=0
- S BARFLG=$$PLB(IMPDA) ;PLB
- S BARFLG=0 ;bar*1.8*20 REQ4
- S BARFLG=$$REV(IMPDA) ;REVERSALS
- S BARFLG=0 ;bar*1.8*20 REQ4
- S BARFLG=$$NEGP(IMPDA) ;NEGATIVE AMT PAYMENT
- ;start new code bar*1.8*20 REQ4
- K DIR
- S DIR(0)="E"
- S DIR("A")="<CR> - Continue"
- D ^DIR
- K ^XTMP("BAR-BILLS",$J,DUZ(2)),^XTMP("BAR-BMAMT",$J,DUZ(2))
- ;end new code REQ4
- Q BARFLG
- ;
- ; **************
- PLB(IMPDA) ; EP ;D159-2
- W !!,"Looking for PLB Segment... "
- S PLBAMT=+$P($G(^BAREDI("I",DUZ(2),IMPDA,5,BARCKIEN,0)),U,9)
- I (PLBAMT=0) W "No PLB Segments found" Q BARFLG ;No PLB
- W "PLB SEGMENT FOUND"
- I (PLBAMT<0) W !?2,"The PLB amount increases the check amount - no further action will be taken" Q BARFLG
- S IENS=BARCKIEN_","_IMPDA
- W !?2,"Bills will be marked Not To Post to accommodate amount ",$FN($$GET1^DIQ(90056.02011,IENS,.09),",",2)
- S BARFLG=1
- D PLBFIND
- ;end new code REQ4
- Q BARFLG
- ;
- REV(IMPDA) ;EP ;D159-1
- ;W !,"Looking for Payment Reversals " ;bar*1.8*20 REQ4
- W !!,"Looking for Payment Reversals... " ;bar*1.8*20 REQ4
- N BARCDA,BAR15,BARAMT,CNT,BARVCK,BARSCK
- S BARCDA=0
- S (BARVCK,BARSCK)=""
- S BAR="REV"
- S REVAMT=0
- S BARCNT=0
- K ^XTMP("BAR-REV",$J) ;bar*1.8*28 IHS/DIT/CPC CR9572 was ;K ^XTMP("BAR=REV",$J)
- F CNT=1:1 S BARCDA=$O(^BAREDI("I",DUZ(2),IMPDA,30,BARCDA)) Q:'BARCDA D
- . ;W:'(CNT#1000) "." ;bar*1.8*20 REQ4
- . ; old code Q:(+$P($G(^BAREDI("I",DUZ(2),IMPDA,30,BARCDA,0)),U,11)'=22) ;only looking for REVERSALS
- . I '$$ISREV(IMPDA,BARCDA) Q ;new code P.OTT 1/10/2014 HEAT148388 1/24/2024 PARAMETER PASSING- BAR*1.8*.24
- .Q:($P($G(^BAREDI("I",DUZ(2),IMPDA,30,BARCDA,2)),U)'=$P($G(^BAREDI("I",DUZ(2),IMPDA,5,BARCKIEN,0)),U)) ;not check number I want
- .I BARFLG=0 D
- ..W "PAYMENT REVERSAL FOUND",!?3,"Bills will be marked Not To Post to accommodate "
- ..W !,?6,"E-Bill#",?27,"E-Pymt",?39,"E-Claim Status Code"
- .S BARFLG=1
- .S BARCNT=+$G(BARCNT)+1
- .S EAMT=$P($G(^BAREDI("I",DUZ(2),IMPDA,30,BARCDA,0)),U,4)
- .S EBILL=$P($G(^BAREDI("I",DUZ(2),IMPDA,30,BARCDA,0)),U)
- .S ESTAT=$P($G(^BAREDI("I",DUZ(2),IMPDA,30,BARCDA,0)),U,11)
- .S ^XTMP("BAR-REV",$J,DUZ(2),BARCDA)=EBILL
- .W !,BARCNT,?6,EBILL,?27,$FN(EAMT,",",2),?39,ESTAT
- .D UP(IMPDA,BARCDA,"REV")
- .S REVAMT=+$G(REVAMT)-$P($G(^BAREDI("I",DUZ(2),IMPDA,30,BARCDA,0)),U,4)
- I BARFLG D REVFIND
- I 'BARFLG W "No Payment Reversals found" Q BARFLG ;No Payment Reversals
- ;end new code REQ4
- Q BARFLG
- ;
- NEGP(IMPDA) ;EP ;D159-1
- ;W !,"Looking for Negative Payments " ;bar*1.8*20 REQ4
- I '$$IHSNEGB^BARUFUT(DUZ(2)) Q 0 ;HEAT147572 line moved to $$NEGP 4/22/2014 bar*1.8*24
- W !!,"Looking for Negative Payments... " ;bar*1.8*20 REQ4
- N BARCDA,BAR300,BARAMT,CNT,BARSTA,BAR302,BARVCK,BARSCK
- S BARCDA=0
- S BARSCK=""
- S BARCNT=0,REVAMT=0 ;bar*1.8*20 REQ4
- F CNT=1:1 S BARCDA=$O(^BAREDI("I",DUZ(2),IMPDA,30,BARCDA)) Q:'BARCDA D
- .;W:'(CNT#1000) "." ;bar*1.8*20 REQ4
- .S BAR300=$G(^BAREDI("I",DUZ(2),IMPDA,30,BARCDA,0))
- .S BAR302=$G(^BAREDI("I",DUZ(2),IMPDA,30,BARCDA,2))
- .S BARVCK=$P(BAR302,U) ;Check number
- .S BARSTA=+$P(BAR300,U,11)
- .I BARSTA="" S BARSTA=$P(BAR302,U,4)
- .Q:(U_"1"_U_"2"_U_"3"_U_"4"_U_"19"_U_"20"_U_"21"_U)'[(U_BARSTA_U) ;Only want PAYMENTS & DENIALS
- .Q:($P($G(^BAREDI("I",DUZ(2),IMPDA,30,BARCDA,2)),U)'=$P($G(^BAREDI("I",DUZ(2),IMPDA,5,BARCKIEN,0)),U)) ;not check number I want
- .S BARAMT=$P(BAR300,U,4)
- .I BARAMT<0 D
- ..;Q:BARVCK=BARSCK ;Only process once for each check P.OTTIS HEAT148388 - BAR*1.8*.24
- ..I BARFLG=0 W "NEGATIVE PAYMENT AMOUNT FOUND",!?2,"Bills will be marked Not To Post to accommodate" ;bar*1.8*20 REQ4
- ..I BARFLG=0 W !,?6,"E-Bill#",?27,"E-Pymt",?39,"E-Claim Status Code" ;bar*1.8*20 REQ4
- ..S BARFLG=1
- ..S BARSCK=BARVCK ;Save Negative amount check number
- ..S BARCNT=+$G(BARCNT)+1
- ..S EAMT=$P($G(^BAREDI("I",DUZ(2),IMPDA,30,BARCDA,0)),U,4)
- ..S EBILL=$P($G(^BAREDI("I",DUZ(2),IMPDA,30,BARCDA,0)),U)
- ..S ^XTMP("BAR-REV",$J,DUZ(2),BARCDA)=EBILL
- ..W !,BARCNT,?6,EBILL,?27,$FN(EAMT,",",2),?39,$P($G(^BAREDI("I",DUZ(2),IMPDA,30,BARCDA,0)),U,11)
- ..D UP(IMPDA,BARCDA,"NEGP")
- ..S REVAMT=+$G(REVAMT)+$P($G(^BAREDI("I",DUZ(2),IMPDA,30,BARCDA,0)),U,4)
- I BARFLG S BAR="NEGP" D REVFIND
- I 'BARFLG W "No Negative Payments found " ;bar*1.8*20 REQ4
- Q BARFLG
- ;
- LOOP(IMPDA,REASON,VCHK) ;EP; LOOP THROUGH BAREDI("I",IMPDA AND FLAG NOT TO POST
- ;
- N BARCDA,TCHK
- S BARCDA=0
- F S BARCDA=$O(^BAREDI("I",DUZ(2),IMPDA,30,BARCDA)) Q:'BARCDA D
- .S TCHK=$P($G(^BAREDI("I",DUZ(2),IMPDA,30,BARCDA,2)),U) ;Transaction check #
- .Q:TCHK'=VCHK ; Limit it to just the one check
- .D UP(IMPDA,BARCDA,REASON)
- Q
- ;
- UP(IMPDA,XCLM,REASON) ;EP; UPDATE STATUS
- K DIR,DIE,DA,DIC,DR,X
- K DIR,DIE,DA,DIC,DR
- S DIC("P")=$P(^DD(90056.0205,401,0),U,2)
- S DA(2)=IMPDA
- S DA(1)=XCLM
- S DIC(0)="L"
- S DIC="^BAREDI(""I"",DUZ(2),"_DA(2)_",30,"_DA(1)_",4,"
- S X=REASON
- D ^DIC
- Q
- ;start new code bar*1.8*20 REQ4
- PLBFIND ; EP
- ;first put all bills for check into bill amount order
- S CLMDA=0
- K ^XTMP("BAR-MBAMT",$J,DUZ(2))
- F S CLMDA=$O(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA)) Q:'CLMDA D
- .Q:($P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,2)),U)'=$P($G(^BAREDI("I",DUZ(2),IMPDA,5,BARCKIEN,0)),U)) ;only my check
- .Q:$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U)="P" ;already posted
- .Q:(("1^2^3^19^20^21^")'[("^"_$P($P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,11)," | ")_"^")) ;not a payment
- .S CHKREASN=$$RCHK
- .;if ERA claim has already been marked NTP for PLB, lessen PLB amount by that ERA claim amount
- .I BARRCHK=1,((CHKREASN)="PLB") D Q
- ..S PLBAMT=PLBAMT-$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,4)
- ..W !?5,$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U)_" for $"_$J($P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,4),2)_" was marked Not To Post"
- .S ^XTMP("BAR-MBAMT",$J,DUZ(2),$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,4),CLMDA)="" ;E-payment
- S BAMT=0,BARDONE=0
- I PLBAMT=0!(PLBAMT<0) Q
- F S BAMT=$O(^XTMP("BAR-MBAMT",$J,DUZ(2),BAMT)) Q:'BAMT D Q:BARDONE
- .Q:(BAMT<PLBAMT) ;bill amount must be = or > than PLB amount
- .S CLMDA=$O(^XTMP("BAR-MBAMT",$J,DUZ(2),BAMT,0)) ;get first claim with that amount
- .;by here the BAMT should be as much or more than the PLB amount
- .D UP(IMPDA,CLMDA,"PLB") ;mark bill Not To Post
- .S BARDONE=1
- .W !?2,$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U)_" for $"_$J($P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,4),2)_" was marked Not To Post"
- Q:BARDONE ;stop here if a bill was found and marked Not To Post
- S BAMT=99999999999
- F S BAMT=$O(^XTMP("BAR-MBAMT",$J,DUZ(2),BAMT),-1) Q:'BAMT D Q:BARDONE
- .S CLMDA=999999
- .F S CLMDA=$O(^XTMP("BAR-MBAMT",$J,DUZ(2),BAMT,CLMDA),-1) Q:'CLMDA D Q:BARDONE
- ..D UP(IMPDA,CLMDA,"PLB") ;mark bill Not To Post
- ..S PLBAMT=PLBAMT-BAMT
- ..I PLBAMT=0!(PLBAMT<0) S BARDONE=1
- ..W !?5,$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U)_" for $"_$J($P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,4),2)_" was marked Not To Post"
- W !
- Q
- REVFIND ;EP
- ;find pymt to "counter" either payment reversal or negative payment and mark it Not To Post
- ;payment can be either on same bill, or different bill, or over several bills to "cover" amount
- S MTCHAMT=$S(REVAMT<0:(REVAMT*-1),1:REVAMT) ;total amount that needs to be written off
- D BUILDLST
- Q:MTCHAMT<0 ;bills have already been marked Not To Post
- ;go through list first time looking for amount on same claim
- S REVDA=0,BARDONE=0
- S EDA=0
- F S EDA=$O(^XTMP("BAR-REV",$J,DUZ(2),EDA)) Q:'EDA D
- .S EBILL=$G(^XTMP("BAR-REV",$J,DUZ(2),EDA))
- .S EAMT=$P($G(^BAREDI("I",DUZ(2),IMPDA,30,EDA,0)),U,4)
- .I $D(^BAREDI("I",DUZ(2),IMPDA,30,EDA,4))>10 Q ;bar*1.8*26 IHS/SD/SDR HEAT263595 ;bar*1.8*28 IHS/SD/SDR CR8346 HEAT275351
- .S EAMT=EAMT*-1
- .I $D(^XTMP("BAR-BILLS",$J,DUZ(2),EBILL)) D
- ..S MDA=0
- ..F S MDA=$O(^XTMP("BAR-BILLS",$J,DUZ(2),EBILL,MDA)) Q:'MDA D
- ...S MAMT=$P($G(^BAREDI("I",DUZ(2),IMPDA,30,EDA,0)),U,4)
- ...I EAMT=MAMT D
- ....S RCLMDA=$O(^XTMP("BAR-BILLS",$J,DUZ(2),EBILL,MDA,0))
- ....D UP(IMPDA,RCLMDA,$S(BAR="REV":"REV",1:"NEGP"))
- ....S MTCHAMT=MTCHAMT-MAMT
- ....W !?6,EBILL,?27,$J(MAMT,",",2),?39,$P($G(^BAREDI("I",DUZ(2),IMPDA,30,MDA,0)),U,11)
- ....K ^XTMP("BAR-BILLS",$J,DUZ(2),EBILL,MDA)
- I MTCHAMT>0 D
- .S MAMT=0
- .F S MAMT=$O(^XTMP("BAR-MBAMT",$J,DUZ(2),MAMT)) Q:'MAMT D
- ..S MDA=0
- ..F S MDA=$O(^XTMP("BAR-MBAMT",$J,DUZ(2),MAMT,MDA)) Q:'MDA D
- ...I $D(^BAREDI("I",DUZ(2),IMPDA,30,MDA,4))>10 Q ;bar*1.8*28 IHS/DIT/CPC CR9572
- ...Q:MTCHAMT'=MAMT
- ...;S RCLMDA=$O(^XTMP("BAR-MBAMT",$J,DUZ(2),EBILL,MDA,0))
- ...D UP(IMPDA,MDA,$S(BAR="REV":"REV",1:"NEGP"))
- ...S MTCHAMT=MTCHAMT-MAMT
- ...W !?6,$P($G(^BAREDI("I",DUZ(2),IMPDA,30,MDA,0)),U),?27,$J(MAMT,",",2),?39,$P($G(^BAREDI("I",DUZ(2),IMPDA,30,MDA,0)),U,11)
- I MTCHAMT>0 D Q:((MTCHAMT=0)!(MTCHAMT<0))
- .S MAMT=999999999
- .F S MAMT=$O(^XTMP("BAR-MBAMT",$J,DUZ(2),MAMT),-1) Q:'MAMT D Q:((MTCHAMT=0)!(MTCHAMT<0))
- ..S MDA=0
- ..F S MDA=$O(^XTMP("BAR-MBAMT",$J,DUZ(2),MAMT,MDA)) Q:'MDA D Q:((MTCHAMT=0)!(MTCHAMT<0))
- ...I $D(^BAREDI("I",DUZ(2),IMPDA,30,MDA,4))>10 Q ;bar*1.8*28 IHS/DIT/CPC CR9572
- ...D UP(IMPDA,MDA,$S(BAR="REV":"REV",1:"NEGP"))
- ...S MTCHAMT=MTCHAMT-MAMT
- ...W !?6,$P($G(^BAREDI("I",DUZ(2),IMPDA,30,MDA,0)),U),?27,$J(MAMT,",",2),?39,$P($G(^BAREDI("I",DUZ(2),IMPDA,30,MDA,0)),U,11)
- W !
- Q
- BUILDLST ;EP
- S CLMDA=0
- K ^XTMP("BAR-MBAMT",$J,DUZ(2)),^XTMP("BAR-BILLS",$J,DUZ(2))
- F S CLMDA=$O(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA)) Q:'CLMDA D
- .Q:($P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,2)),U)'=$P($G(^BAREDI("I",DUZ(2),IMPDA,5,BARCKIEN,0)),U)) ;only my check
- .Q:$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,2)="P" ;already posted
- .Q:$D(^XTMP("BAR-REV",$J,DUZ(2),CLMDA)) ;bill is reversal
- .S CHKREASN=$$RCHK
- .;if ERA claim has already been marked NTP for PLB, lessen PLB amount by that ERA claim amount
- .I BARRCHK=1,((CHKREASN)=$S(BAR="REV":"REV",1:"NEGP")) D Q
- ..S MTCHAMT=MTCHAMT-(+$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,4)) ;bar*1.8*28 IHS/DIT/CPC CR9572
- ..W !?6,$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U),?27,$J($P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,4),",",2),?39,$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,11)
- .S ^XTMP("BAR-MBAMT",$J,DUZ(2),+$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,4),CLMDA)="" ;E-payment ;bar*1.8*28 IHS/DIT/CPC CR9572
- .S ^XTMP("BAR-BILLS",$J,DUZ(2),$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U),+$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,4),CLMDA)="" ;bills
- Q
- RCHK(CHKREASN) ;
- S BARRCHK=0,CHKREASN=""
- Q:'$D(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,4)) CHKREASN ;no reasons not to post
- S BARNTPR=0
- F S BARNTPR=$O(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,4,BARNTPR)) Q:'BARNTPR D Q:CHKREASN
- .I "^PLB^REV^NEGP^"[("^"_$P($G(^BARERR($P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,4,BARNTPR,0)),U),0)),U)_"^") D
- ..S BARRCHK=1
- ..S CHKREASN=$P($G(^BARERR($P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,4,BARNTPR,0)),U),0)),U)
- Q CHKREASN
- ;end new code REQ4
- ISREV(IMPDA,CLMDA) ;P.OTT 1/10/2014 HEAT148388- BAR*1.8*.24
- I +$$GET1^DIQ(90056.0205,CLMDA_","_IMPDA_",",.11)=22 Q 1
- Q 0
- ;----------------
- BAREDP0Z ; IHS/SD/LSL - MATCH REASONS AND CLAIMS ; 01/30/2009
- +1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**10,20,23,24,28**;OCT 26, 2005;Build 92
- +2 ; NEW ROUTINE TO LOCKOUT REVERSALS AND PLB SEGMENTS; MRS:BAR*1.8*10 D159
- +3 ; MODIFIED TO LIMIT LOCK OUT TO INDIVIDUAL CHECKS
- +4 ;IHS/SD/POT HEAT148388 ACCEPT REVERSALS FOR TYPE= 1 IF NEG PAYMENT FIX: 1/24/2014- BAR*1.8*.24
- +5 ;IHS/SD/POT HEAT147572 ALLOW TRIBAL SITES ERA POSTING OF NEG BAL & CANCELLED BILLS- BAR*1.8*.24
- +6 ;IHS/SD/POT check for IHSNEGB moved from top to $$NEGP - BAR*1.8*.24
- +7 ;IHS/DIT/CPC Fix typo CR9572 BAR*1.8*28
- +8 QUIT
- EN(IMPDA) ; EP ; Scan SEGMENTS for PLB, REVERSALS AND NEGATIVE AMOUNTS
- +1 NEW BARFLG
- +2 ;old code Q:'$$IHS^BARUFUT(DUZ(2)) 0 ;Ignore if NON-IHS facility
- +3 ;I '$$IHSNEGB^BARUFUT(DUZ(2)) Q 0 ;HEAT147572 line moved to $$NEGP 4/22/2014
- +4 ;bar*1.8*20 REQ4
- WRITE !!,"Now will look for PLBs, Payment Reversals, and Negative Payments..."
- +5 SET BARFLG=0
- +6 ;PLB
- SET BARFLG=$$PLB(IMPDA)
- +7 ;bar*1.8*20 REQ4
- SET BARFLG=0
- +8 ;REVERSALS
- SET BARFLG=$$REV(IMPDA)
- +9 ;bar*1.8*20 REQ4
- SET BARFLG=0
- +10 ;NEGATIVE AMT PAYMENT
- SET BARFLG=$$NEGP(IMPDA)
- +11 ;start new code bar*1.8*20 REQ4
- +12 KILL DIR
- +13 SET DIR(0)="E"
- +14 SET DIR("A")="<CR> - Continue"
- +15 DO ^DIR
- +16 KILL ^XTMP("BAR-BILLS",$JOB,DUZ(2)),^XTMP("BAR-BMAMT",$JOB,DUZ(2))
- +17 ;end new code REQ4
- +18 QUIT BARFLG
- +19 ;
- +20 ; **************
- PLB(IMPDA) ; EP ;D159-2
- +1 WRITE !!,"Looking for PLB Segment... "
- +2 SET PLBAMT=+$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,5,BARCKIEN,0)),U,9)
- +3 ;No PLB
- IF (PLBAMT=0)
- WRITE "No PLB Segments found"
- QUIT BARFLG
- +4 WRITE "PLB SEGMENT FOUND"
- +5 IF (PLBAMT<0)
- WRITE !?2,"The PLB amount increases the check amount - no further action will be taken"
- QUIT BARFLG
- +6 SET IENS=BARCKIEN_","_IMPDA
- +7 WRITE !?2,"Bills will be marked Not To Post to accommodate amount ",$FNUMBER($$GET1^DIQ(90056.02011,IENS,.09),",",2)
- +8 SET BARFLG=1
- +9 DO PLBFIND
- +10 ;end new code REQ4
- +11 QUIT BARFLG
- +12 ;
- REV(IMPDA) ;EP ;D159-1
- +1 ;W !,"Looking for Payment Reversals " ;bar*1.8*20 REQ4
- +2 ;bar*1.8*20 REQ4
- WRITE !!,"Looking for Payment Reversals... "
- +3 NEW BARCDA,BAR15,BARAMT,CNT,BARVCK,BARSCK
- +4 SET BARCDA=0
- +5 SET (BARVCK,BARSCK)=""
- +6 SET BAR="REV"
- +7 SET REVAMT=0
- +8 SET BARCNT=0
- +9 ;bar*1.8*28 IHS/DIT/CPC CR9572 was ;K ^XTMP("BAR=REV",$J)
- KILL ^XTMP("BAR-REV",$JOB)
- +10 FOR CNT=1:1
- SET BARCDA=$ORDER(^BAREDI("I",DUZ(2),IMPDA,30,BARCDA))
- IF 'BARCDA
- QUIT
- Begin DoDot:1
- +11 ;W:'(CNT#1000) "." ;bar*1.8*20 REQ4
- +12 ; old code Q:(+$P($G(^BAREDI("I",DUZ(2),IMPDA,30,BARCDA,0)),U,11)'=22) ;only looking for REVERSALS
- +13 ;new code P.OTT 1/10/2014 HEAT148388 1/24/2024 PARAMETER PASSING- BAR*1.8*.24
- IF '$$ISREV(IMPDA,BARCDA)
- QUIT
- +14 ;not check number I want
- IF ($PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,BARCDA,2)),U)'=$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,5,BARCKIEN,0)),U))
- QUIT
- +15 IF BARFLG=0
- Begin DoDot:2
- +16 WRITE "PAYMENT REVERSAL FOUND",!?3,"Bills will be marked Not To Post to accommodate "
- +17 WRITE !,?6,"E-Bill#",?27,"E-Pymt",?39,"E-Claim Status Code"
- End DoDot:2
- +18 SET BARFLG=1
- +19 SET BARCNT=+$GET(BARCNT)+1
- +20 SET EAMT=$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,BARCDA,0)),U,4)
- +21 SET EBILL=$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,BARCDA,0)),U)
- +22 SET ESTAT=$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,BARCDA,0)),U,11)
- +23 SET ^XTMP("BAR-REV",$JOB,DUZ(2),BARCDA)=EBILL
- +24 WRITE !,BARCNT,?6,EBILL,?27,$FNUMBER(EAMT,",",2),?39,ESTAT
- +25 DO UP(IMPDA,BARCDA,"REV")
- +26 SET REVAMT=+$GET(REVAMT)-$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,BARCDA,0)),U,4)
- End DoDot:1
- +27 IF BARFLG
- DO REVFIND
- +28 ;No Payment Reversals
- IF 'BARFLG
- WRITE "No Payment Reversals found"
- QUIT BARFLG
- +29 ;end new code REQ4
- +30 QUIT BARFLG
- +31 ;
- NEGP(IMPDA) ;EP ;D159-1
- +1 ;W !,"Looking for Negative Payments " ;bar*1.8*20 REQ4
- +2 ;HEAT147572 line moved to $$NEGP 4/22/2014 bar*1.8*24
- IF '$$IHSNEGB^BARUFUT(DUZ(2))
- QUIT 0
- +3 ;bar*1.8*20 REQ4
- WRITE !!,"Looking for Negative Payments... "
- +4 NEW BARCDA,BAR300,BARAMT,CNT,BARSTA,BAR302,BARVCK,BARSCK
- +5 SET BARCDA=0
- +6 SET BARSCK=""
- +7 ;bar*1.8*20 REQ4
- SET BARCNT=0
- SET REVAMT=0
- +8 FOR CNT=1:1
- SET BARCDA=$ORDER(^BAREDI("I",DUZ(2),IMPDA,30,BARCDA))
- IF 'BARCDA
- QUIT
- Begin DoDot:1
- +9 ;W:'(CNT#1000) "." ;bar*1.8*20 REQ4
- +10 SET BAR300=$GET(^BAREDI("I",DUZ(2),IMPDA,30,BARCDA,0))
- +11 SET BAR302=$GET(^BAREDI("I",DUZ(2),IMPDA,30,BARCDA,2))
- +12 ;Check number
- SET BARVCK=$PIECE(BAR302,U)
- +13 SET BARSTA=+$PIECE(BAR300,U,11)
- +14 IF BARSTA=""
- SET BARSTA=$PIECE(BAR302,U,4)
- +15 ;Only want PAYMENTS & DENIALS
- IF (U_"1"_U_"2"_U_"3"_U_"4"_U_"19"_U_"20"_U_"21"_U)'[(U_BARSTA_U)
- QUIT
- +16 ;not check number I want
- IF ($PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,BARCDA,2)),U)'=$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,5,BARCKIEN,0)),U))
- QUIT
- +17 SET BARAMT=$PIECE(BAR300,U,4)
- +18 IF BARAMT<0
- Begin DoDot:2
- +19 ;Q:BARVCK=BARSCK ;Only process once for each check P.OTTIS HEAT148388 - BAR*1.8*.24
- +20 ;bar*1.8*20 REQ4
- IF BARFLG=0
- WRITE "NEGATIVE PAYMENT AMOUNT FOUND",!?2,"Bills will be marked Not To Post to accommodate"
- +21 ;bar*1.8*20 REQ4
- IF BARFLG=0
- WRITE !,?6,"E-Bill#",?27,"E-Pymt",?39,"E-Claim Status Code"
- +22 SET BARFLG=1
- +23 ;Save Negative amount check number
- SET BARSCK=BARVCK
- +24 SET BARCNT=+$GET(BARCNT)+1
- +25 SET EAMT=$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,BARCDA,0)),U,4)
- +26 SET EBILL=$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,BARCDA,0)),U)
- +27 SET ^XTMP("BAR-REV",$JOB,DUZ(2),BARCDA)=EBILL
- +28 WRITE !,BARCNT,?6,EBILL,?27,$FNUMBER(EAMT,",",2),?39,$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,BARCDA,0)),U,11)
- +29 DO UP(IMPDA,BARCDA,"NEGP")
- +30 SET REVAMT=+$GET(REVAMT)+$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,BARCDA,0)),U,4)
- End DoDot:2
- End DoDot:1
- +31 IF BARFLG
- SET BAR="NEGP"
- DO REVFIND
- +32 ;bar*1.8*20 REQ4
- IF 'BARFLG
- WRITE "No Negative Payments found "
- +33 QUIT BARFLG
- +34 ;
- LOOP(IMPDA,REASON,VCHK) ;EP; LOOP THROUGH BAREDI("I",IMPDA AND FLAG NOT TO POST
- +1 ;
- +2 NEW BARCDA,TCHK
- +3 SET BARCDA=0
- +4 FOR
- SET BARCDA=$ORDER(^BAREDI("I",DUZ(2),IMPDA,30,BARCDA))
- IF 'BARCDA
- QUIT
- Begin DoDot:1
- +5 ;Transaction check #
- SET TCHK=$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,BARCDA,2)),U)
- +6 ; Limit it to just the one check
- IF TCHK'=VCHK
- QUIT
- +7 DO UP(IMPDA,BARCDA,REASON)
- End DoDot:1
- +8 QUIT
- +9 ;
- UP(IMPDA,XCLM,REASON) ;EP; UPDATE STATUS
- +1 KILL DIR,DIE,DA,DIC,DR,X
- +2 KILL DIR,DIE,DA,DIC,DR
- +3 SET DIC("P")=$PIECE(^DD(90056.0205,401,0),U,2)
- +4 SET DA(2)=IMPDA
- +5 SET DA(1)=XCLM
- +6 SET DIC(0)="L"
- +7 SET DIC="^BAREDI(""I"",DUZ(2),"_DA(2)_",30,"_DA(1)_",4,"
- +8 SET X=REASON
- +9 DO ^DIC
- +10 QUIT
- +11 ;start new code bar*1.8*20 REQ4
- PLBFIND ; EP
- +1 ;first put all bills for check into bill amount order
- +2 SET CLMDA=0
- +3 KILL ^XTMP("BAR-MBAMT",$JOB,DUZ(2))
- +4 FOR
- SET CLMDA=$ORDER(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA))
- IF 'CLMDA
- QUIT
- Begin DoDot:1
- +5 ;only my check
- IF ($PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,2)),U)'=$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,5,BARCKIEN,0)),U))
- QUIT
- +6 ;already posted
- IF $PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U)="P"
- QUIT
- +7 ;not a payment
- IF (("1^2^3^19^20^21^")'[("^"_$PIECE($PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,11)," | ")_"^"))
- QUIT
- +8 SET CHKREASN=$$RCHK
- +9 ;if ERA claim has already been marked NTP for PLB, lessen PLB amount by that ERA claim amount
- +10 IF BARRCHK=1
- IF ((CHKREASN)="PLB")
- Begin DoDot:2
- +11 SET PLBAMT=PLBAMT-$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,4)
- +12 WRITE !?5,$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U)_" for $"_$JUSTIFY($PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,4),2)_" was marked Not To Post"
- End DoDot:2
- QUIT
- +13 ;E-payment
- SET ^XTMP("BAR-MBAMT",$JOB,DUZ(2),$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,4),CLMDA)=""
- End DoDot:1
- +14 SET BAMT=0
- SET BARDONE=0
- +15 IF PLBAMT=0!(PLBAMT<0)
- QUIT
- +16 FOR
- SET BAMT=$ORDER(^XTMP("BAR-MBAMT",$JOB,DUZ(2),BAMT))
- IF 'BAMT
- QUIT
- Begin DoDot:1
- +17 ;bill amount must be = or > than PLB amount
- IF (BAMT<PLBAMT)
- QUIT
- +18 ;get first claim with that amount
- SET CLMDA=$ORDER(^XTMP("BAR-MBAMT",$JOB,DUZ(2),BAMT,0))
- +19 ;by here the BAMT should be as much or more than the PLB amount
- +20 ;mark bill Not To Post
- DO UP(IMPDA,CLMDA,"PLB")
- +21 SET BARDONE=1
- +22 WRITE !?2,$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U)_" for $"_$JUSTIFY($PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,4),2)_" was marked Not To Post"
- End DoDot:1
- IF BARDONE
- QUIT
- +23 ;stop here if a bill was found and marked Not To Post
- IF BARDONE
- QUIT
- +24 SET BAMT=99999999999
- +25 FOR
- SET BAMT=$ORDER(^XTMP("BAR-MBAMT",$JOB,DUZ(2),BAMT),-1)
- IF 'BAMT
- QUIT
- Begin DoDot:1
- +26 SET CLMDA=999999
- +27 FOR
- SET CLMDA=$ORDER(^XTMP("BAR-MBAMT",$JOB,DUZ(2),BAMT,CLMDA),-1)
- IF 'CLMDA
- QUIT
- Begin DoDot:2
- +28 ;mark bill Not To Post
- DO UP(IMPDA,CLMDA,"PLB")
- +29 SET PLBAMT=PLBAMT-BAMT
- +30 IF PLBAMT=0!(PLBAMT<0)
- SET BARDONE=1
- +31 WRITE !?5,$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U)_" for $"_$JUSTIFY($PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,4),2)_" was marked Not To Post"
- End DoDot:2
- IF BARDONE
- QUIT
- End DoDot:1
- IF BARDONE
- QUIT
- +32 WRITE !
- +33 QUIT
- REVFIND ;EP
- +1 ;find pymt to "counter" either payment reversal or negative payment and mark it Not To Post
- +2 ;payment can be either on same bill, or different bill, or over several bills to "cover" amount
- +3 ;total amount that needs to be written off
- SET MTCHAMT=$SELECT(REVAMT<0:(REVAMT*-1),1:REVAMT)
- +4 DO BUILDLST
- +5 ;bills have already been marked Not To Post
- IF MTCHAMT<0
- QUIT
- +6 ;go through list first time looking for amount on same claim
- +7 SET REVDA=0
- SET BARDONE=0
- +8 SET EDA=0
- +9 FOR
- SET EDA=$ORDER(^XTMP("BAR-REV",$JOB,DUZ(2),EDA))
- IF 'EDA
- QUIT
- Begin DoDot:1
- +10 SET EBILL=$GET(^XTMP("BAR-REV",$JOB,DUZ(2),EDA))
- +11 SET EAMT=$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,EDA,0)),U,4)
- +12 ;bar*1.8*26 IHS/SD/SDR HEAT263595 ;bar*1.8*28 IHS/SD/SDR CR8346 HEAT275351
- IF $DATA(^BAREDI("I",DUZ(2),IMPDA,30,EDA,4))>10
- QUIT
- +13 SET EAMT=EAMT*-1
- +14 IF $DATA(^XTMP("BAR-BILLS",$JOB,DUZ(2),EBILL))
- Begin DoDot:2
- +15 SET MDA=0
- +16 FOR
- SET MDA=$ORDER(^XTMP("BAR-BILLS",$JOB,DUZ(2),EBILL,MDA))
- IF 'MDA
- QUIT
- Begin DoDot:3
- +17 SET MAMT=$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,EDA,0)),U,4)
- +18 IF EAMT=MAMT
- Begin DoDot:4
- +19 SET RCLMDA=$ORDER(^XTMP("BAR-BILLS",$JOB,DUZ(2),EBILL,MDA,0))
- +20 DO UP(IMPDA,RCLMDA,$SELECT(BAR="REV":"REV",1:"NEGP"))
- +21 SET MTCHAMT=MTCHAMT-MAMT
- +22 WRITE !?6,EBILL,?27,$JUSTIFY(MAMT,",",2),?39,$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,MDA,0)),U,11)
- +23 KILL ^XTMP("BAR-BILLS",$JOB,DUZ(2),EBILL,MDA)
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +24 IF MTCHAMT>0
- Begin DoDot:1
- +25 SET MAMT=0
- +26 FOR
- SET MAMT=$ORDER(^XTMP("BAR-MBAMT",$JOB,DUZ(2),MAMT))
- IF 'MAMT
- QUIT
- Begin DoDot:2
- +27 SET MDA=0
- +28 FOR
- SET MDA=$ORDER(^XTMP("BAR-MBAMT",$JOB,DUZ(2),MAMT,MDA))
- IF 'MDA
- QUIT
- Begin DoDot:3
- +29 ;bar*1.8*28 IHS/DIT/CPC CR9572
- IF $DATA(^BAREDI("I",DUZ(2),IMPDA,30,MDA,4))>10
- QUIT
- +30 IF MTCHAMT'=MAMT
- QUIT
- +31 ;S RCLMDA=$O(^XTMP("BAR-MBAMT",$J,DUZ(2),EBILL,MDA,0))
- +32 DO UP(IMPDA,MDA,$SELECT(BAR="REV":"REV",1:"NEGP"))
- +33 SET MTCHAMT=MTCHAMT-MAMT
- +34 WRITE !?6,$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,MDA,0)),U),?27,$JUSTIFY(MAMT,",",2),?39,$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,MDA,0)),U,11)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +35 IF MTCHAMT>0
- Begin DoDot:1
- +36 SET MAMT=999999999
- +37 FOR
- SET MAMT=$ORDER(^XTMP("BAR-MBAMT",$JOB,DUZ(2),MAMT),-1)
- IF 'MAMT
- QUIT
- Begin DoDot:2
- +38 SET MDA=0
- +39 FOR
- SET MDA=$ORDER(^XTMP("BAR-MBAMT",$JOB,DUZ(2),MAMT,MDA))
- IF 'MDA
- QUIT
- Begin DoDot:3
- +40 ;bar*1.8*28 IHS/DIT/CPC CR9572
- IF $DATA(^BAREDI("I",DUZ(2),IMPDA,30,MDA,4))>10
- QUIT
- +41 DO UP(IMPDA,MDA,$SELECT(BAR="REV":"REV",1:"NEGP"))
- +42 SET MTCHAMT=MTCHAMT-MAMT
- +43 WRITE !?6,$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,MDA,0)),U),?27,$JUSTIFY(MAMT,",",2),?39,$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,MDA,0)),U,11)
- End DoDot:3
- IF ((MTCHAMT=0)!(MTCHAMT<0))
- QUIT
- End DoDot:2
- IF ((MTCHAMT=0)!(MTCHAMT<0))
- QUIT
- End DoDot:1
- IF ((MTCHAMT=0)!(MTCHAMT<0))
- QUIT
- +44 WRITE !
- +45 QUIT
- BUILDLST ;EP
- +1 SET CLMDA=0
- +2 KILL ^XTMP("BAR-MBAMT",$JOB,DUZ(2)),^XTMP("BAR-BILLS",$JOB,DUZ(2))
- +3 FOR
- SET CLMDA=$ORDER(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA))
- IF 'CLMDA
- QUIT
- Begin DoDot:1
- +4 ;only my check
- IF ($PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,2)),U)'=$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,5,BARCKIEN,0)),U))
- QUIT
- +5 ;already posted
- IF $PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,2)="P"
- QUIT
- +6 ;bill is reversal
- IF $DATA(^XTMP("BAR-REV",$JOB,DUZ(2),CLMDA))
- QUIT
- +7 SET CHKREASN=$$RCHK
- +8 ;if ERA claim has already been marked NTP for PLB, lessen PLB amount by that ERA claim amount
- +9 IF BARRCHK=1
- IF ((CHKREASN)=$SELECT(BAR="REV":"REV",1:"NEGP"))
- Begin DoDot:2
- +10 ;bar*1.8*28 IHS/DIT/CPC CR9572
- SET MTCHAMT=MTCHAMT-(+$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,4))
- +11 WRITE !?6,$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U),?27,$JUSTIFY($PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,4),",",2),?39,$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,11)
- End DoDot:2
- QUIT
- +12 ;E-payment ;bar*1.8*28 IHS/DIT/CPC CR9572
- SET ^XTMP("BAR-MBAMT",$JOB,DUZ(2),+$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,4),CLMDA)=""
- +13 ;bills
- SET ^XTMP("BAR-BILLS",$JOB,DUZ(2),$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U),+$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,4),CLMDA)=""
- End DoDot:1
- +14 QUIT
- RCHK(CHKREASN) ;
- +1 SET BARRCHK=0
- SET CHKREASN=""
- +2 ;no reasons not to post
- IF '$DATA(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,4))
- QUIT CHKREASN
- +3 SET BARNTPR=0
- +4 FOR
- SET BARNTPR=$ORDER(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,4,BARNTPR))
- IF 'BARNTPR
- QUIT
- Begin DoDot:1
- +5 IF "^PLB^REV^NEGP^"[("^"_$PIECE($GET(^BARERR($PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,4,BARNTPR,0)),U),0)),U)_"^")
- Begin DoDot:2
- +6 SET BARRCHK=1
- +7 SET CHKREASN=$PIECE($GET(^BARERR($PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,4,BARNTPR,0)),U),0)),U)
- End DoDot:2
- End DoDot:1
- IF CHKREASN
- QUIT
- +8 QUIT CHKREASN
- +9 ;end new code REQ4
- ISREV(IMPDA,CLMDA) ;P.OTT 1/10/2014 HEAT148388- BAR*1.8*.24
- +1 IF +$$GET1^DIQ(90056.0205,CLMDA_","_IMPDA_",",.11)=22
- QUIT 1
- +2 QUIT 0
- +3 ;----------------