BAREDEP1 ; IHS/SD/TPF - AR ERA NONPAYMENT CHECKER ; 01/30/2009
;;1.8;IHS ACCOUNTS RECEIVABLE;**5,6,10,22,23,24,28**;OCT 26,2005;Build 92
;IHS/SD/POT HEAT82698 NOV 2012 LEADING ZEROES IN CHKECK # (POS) - BAR*1.8*23
; FEB 13 ADDED INFO ON NONPAY DETAILS; SHOW CLMPYMT
; MAR 13 EXCLUDED COL BATCHES OLDER THAN 365 DAYS
; REFINED 'OVERRIDE' FLAG WITH MESSAGE - BAR*1.8*23
; 10/10/13 FIXED ERR MSG FOR ERROR NIPAC
;IHS/SD/POT HEAT147572 ALLOW TRIBAL SITES ERA POSTING OF NEG BAL - BAR*1.8*24
; 02/04/14 BLOCK ERROR NIPAC (TDN/IPAC MISSING IN RPMS BATCH AND ITEM) FOR TRIBAL SITES - BAR*1.8*24
;IHS/DIT/CPC - 20180514 CR9572 Recheck reversals - BAR*1.8*28
Q
NONPAYCH(IMPDA) ;EP - CHECK PAYMENTS NOT MATCHED WITH A REVERSAL
N CLMDA,ERACHECK,CLSTATUS,POSTAS,CNT,CLIENS
N BPR02 ;BAR*1.8*6 SCR119
I $G(BARDBG) W !!!,"LOOKING FOR NON-MATCHED PAYMENTS AGAINST NONPAYMENT BATCHES"
S CLMDA=0,CLMPYMT=0 F S CLMDA=$O(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA)) Q:'CLMDA D
.S CLMPYMT=CLMPYMT+$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,4)
S CLMDA=0
F CNT=1:1 S CLMDA=$O(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA)) Q:'CLMDA D
. W:'(CNT#1000) "."
. Q:$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,2)="P" ;DON'T CHECK POSTED CLAIMS
. ;Q:$D(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,4,"B",44)) ;DON'T PROCESS USER STATUS OVVERRIDE BAR*1.8*6 SCR120
. Q:$$OVERIDE^BAREDEP1(CLMDA) ;MRS:BAR*1.8*10 D159-1 AND 2
. 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
. S CLIENS=CLMDA_","_IMPDA_","
. S ERACHECK=$$GET1^DIQ(90056.0205,CLIENS,201,"E") ;CHECK/EFT TRACE
. S CLSTATUS=$P($$GET1^DIQ(90056.0205,CLIENS,.11,"E")," ") ;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_"19"_U_"20"_U_"21"_U)'[(U_CLSTATUS_U) ;PRIMARY,SECONDARY,TERTIARY AS WELL AS THOSE 19,20,21 FORWARDED TO ADDITIONAL PAYER BAR*1.8*6 IM29637
. S POSTAS=$$GET1^DIQ(90056.0205,CLIENS,501,"I")
. Q:POSTAS=138!(POSTAS=139)
. D NONPAY(ERACHECK,IMPDA,CLMDA,BPR02) ;BAR*1.8*6 SCR119
Q
NONPAY(ERACHECK,IMPDA,CLMDA,BPR02) ;EP - SEE IF TDN/IPAC = NONPAYMENT ;BAR*1.8*6 SCR119 IHS/SD/TPF
N TDNIPAC,BARCOLDA,ERRORS,BARITMDA,NONPAY,NOITEM,NOHEAD,BARXCHK ;P.OTT
S BARXCHK=$$BARXCHK^BAREDP09(ERACHECK) ;P.OTT
S (NOITEM,NOHEAD,NONPAY)=0
S BARCOLDA=$O(^BARCOL(DUZ(2),"D",BARXCHK,""))
I 'BARCOLDA,(BPR02=0) Q ;BAR*1.8*6 SCR119
I 'BARCOLDA D Q
. S ERRORS("NB")="" ;NO BATCH FOUND FOR ERA CHECK
. D ADDREAS^BAREDP04(IMPDA,CLMDA,.ERRORS)
. K ERRORS
;CHECK ALL ERACHECK BATCHES/ITEMS FOR A NONPAYMENT
NEW BARTODAY,%H
S X=DT D H^%DTC ;GET $H-FORMAT
S BARTODAY=%H
S BARCOLDA="" F S BARCOLDA=$O(^BARCOL(DUZ(2),"D",BARXCHK,BARCOLDA)) Q:BARCOLDA="" D
. NEW X,BARCBDT,BARCB
. S X=$$GET1^DIQ(90051.01,BARCOLDA_",",4,"I")
. D H^%DTC ;GET $H-FORMAT
. S BARCBDT=%H
. IF BARTODAY-BARCBDT>365 D Q ;TOO OLD
. . S BARCB=$$GET1^DIQ(90051.01,BARCOLDA_",",.01,"A")
. . S BARMSG="IGNORING COLL. BATCH "_BARCB_" EIN# "_BARCOLDA_" TOO OLD: ("_X_")"
. . D INS^BAR50DET(BARMSG,0)
. S TDNIPAC=$$GET1^DIQ(90051.01,BARCOLDA_",",28,"E")
. I TDNIPAC="" S NOHEAD=1
. Q:TDNIPAC'=""&(TDNIPAC'="NONPAYMENT")
. I TDNIPAC="NONPAYMENT",(CLMPYMT'=0) D Q
. . S ERRORS("P NP")=""
. . I $G(BARDBG) D DETAILS(0) ;COL LEVEL
. . Q
. S BARITMDA="" S BARITMDA=$O(^BARCOL(DUZ(2),"D",BARXCHK,BARCOLDA,BARITMDA)) Q:BARITMDA="" D
. . S TDNIPAC=$$GET1^DIQ(90051.1101,BARITMDA_","_BARCOLDA_",",20,"E")
. . I TDNIPAC="" S NOITEM=1
. . I TDNIPAC="NONPAYMENT",(CLMPYMT'=0) D Q
. . . S ERRORS("P NP")=""
. . . I $G(BARDBG) D DETAILS(1) ;DATAIL LEVEL
. . . Q
. ;IF THERE ARE NO TDN FOR BOTH TOP LEVEL AND ITEM LEVEL THEN THIS IS ONE WITH MISSING TDN
. ;ONE OR THE OTHER HAS TO BE POPULATED
. I NOITEM,NOHEAD D
. . I '$$IHS^BARUFUT(DUZ(2)) Q ;2/4/2014 NOT FOR TRIBAL SITES - BAR*1.8*24
. . S ERRORS("NIPAC")="" ;TDN/IPAC MISSING IN RPMS BATCH AND ITEM
. . ;NEW BARMSG
. . ;I $G(BARDBG) D
. . ;. S BARMSG="BATCH "_BARCOLD_" PROBLEM WITH ERA CHECK: "_ERACHECK_" NO TDN FOR BOTH TOP LEVEL AND ITEM LEVEL"
. . ;. D INS^BAR50DET(BARMSG,0) ;10/10/2013
. S (NOITEM,NOHEAD)=0
I $D(ERRORS) D
. ;I $G(BARDBG) D
. ;. S BARMSG="PROBLEM WITH ERA CHECK: "_ERACHECK D INS^BAR50DET(BARMSG,0) ;10/10/13
. ;. D SHOWERR
. D ADDREAS^BAREDP04(IMPDA,CLMDA,.ERRORS)
. K ERRORS
Q
;
OVERIDE(X) ;EP; EXTRINSIC FUNCTION TO CHECK FOR OVERRIDES MRS:BAR*1.8*10 D159-2
; ENTERS WITH X = CLAIM IEN
N BAROR,I
S BAROR=0 ;NOT AN OVERRIDE
;NODE 44 = USER STATUS OVVERRIDE
; 45 = PLB CHECK
; 46 = REVERSAL
; 47 = NEGATIVE PAYMENT
F I=44:1:47 I $D(^BAREDI("I",DUZ(2),IMPDA,30,X,4,"B",I)) D
. I I=44 S BAROR="1^USER STATUS OVERRIDE" Q
. I I=45 S BAROR="1^PLB CHECK" Q
.; I I=46 S BAROR="1^REVERSAL" Q ;IHS/DIT/CPC - 20180514 CR9572 Recheck reversals - BAR*1.8*28
.; I I=47 S BAROR="1^NEGATIVE PAYMENT" Q ;IHS/DIT/CPC - 20180514 CR9572 Recheck neg pymnt - BAR*1.8*28
Q BAROR
DETAILS(BARLEVEL) ;
QUIT ;DROPPED - BAR*1.8*24
S BARMSG="ERA CHK#: "_ERACHECK I ERACHECK'=BARXCHK S BARMSG=BARMSG_" (A/R CHK# "_BARXCHK_")"
S BARMSG=BARMSG_" COLL DA: "_BARCOLDA
S BARMSG=BARMSG_" ERA PAYMENT: "_CLMPYMT
D INS^BAR50DET(BARMSG,0)
I BARLEVEL=1 S BARMSG=" ITEM#: "_BARITMDA D INS^BAR50DET(BARMSG,0)
S BARMSG="ERR CODE(S): "
I $D(ERRORS("P NP")) S BARMSG=BARMSG_"P NP"
I $D(ERRORS("NEGP")) S BARMSG=BARMSG_"; NEGP"
D INS^BAR50DET(BARMSG,0)
Q
SHOWERR ;DROPPED - BAR*1.8*24
NEW I,J,BARTMP
S BARTMP="",I="" F S I=$O(ERRORS(I)) Q:I="" S J="" F S J=$O(^BARERR("B",I,J)) Q:J="" D
. S BARMSG=$P($G(^BARERR(J,0)),U,2)
. D INS^BAR50DET(BARMSG,0)
Q ;EOR
BAREDEP1 ; IHS/SD/TPF - AR ERA NONPAYMENT CHECKER ; 01/30/2009
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**5,6,10,22,23,24,28**;OCT 26,2005;Build 92
+2 ;IHS/SD/POT HEAT82698 NOV 2012 LEADING ZEROES IN CHKECK # (POS) - BAR*1.8*23
+3 ; FEB 13 ADDED INFO ON NONPAY DETAILS; SHOW CLMPYMT
+4 ; MAR 13 EXCLUDED COL BATCHES OLDER THAN 365 DAYS
+5 ; REFINED 'OVERRIDE' FLAG WITH MESSAGE - BAR*1.8*23
+6 ; 10/10/13 FIXED ERR MSG FOR ERROR NIPAC
+7 ;IHS/SD/POT HEAT147572 ALLOW TRIBAL SITES ERA POSTING OF NEG BAL - BAR*1.8*24
+8 ; 02/04/14 BLOCK ERROR NIPAC (TDN/IPAC MISSING IN RPMS BATCH AND ITEM) FOR TRIBAL SITES - BAR*1.8*24
+9 ;IHS/DIT/CPC - 20180514 CR9572 Recheck reversals - BAR*1.8*28
+10 QUIT
NONPAYCH(IMPDA) ;EP - CHECK PAYMENTS NOT MATCHED WITH A REVERSAL
+1 NEW CLMDA,ERACHECK,CLSTATUS,POSTAS,CNT,CLIENS
+2 ;BAR*1.8*6 SCR119
NEW BPR02
+3 IF $GET(BARDBG)
WRITE !!!,"LOOKING FOR NON-MATCHED PAYMENTS AGAINST NONPAYMENT BATCHES"
+4 SET CLMDA=0
SET CLMPYMT=0
FOR
SET CLMDA=$ORDER(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA))
IF 'CLMDA
QUIT
Begin DoDot:1
+5 SET CLMPYMT=CLMPYMT+$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,4)
End DoDot:1
+6 SET CLMDA=0
+7 FOR CNT=1:1
SET CLMDA=$ORDER(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA))
IF 'CLMDA
QUIT
Begin DoDot:1
+8 IF '(CNT#1000)
WRITE "."
+9 ;DON'T CHECK POSTED CLAIMS
IF $PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,2)="P"
QUIT
+10 ;Q:$D(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,4,"B",44)) ;DON'T PROCESS USER STATUS OVVERRIDE BAR*1.8*6 SCR120
+11 ;MRS:BAR*1.8*10 D159-1 AND 2
IF $$OVERIDE^BAREDEP1(CLMDA)
QUIT
+12 ;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)
+13 SET CLIENS=CLMDA_","_IMPDA_","
+14 ;CHECK/EFT TRACE
SET ERACHECK=$$GET1^DIQ(90056.0205,CLIENS,201,"E")
+15 ;E-CLAIM STATUS CODE (CLP02)
SET CLSTATUS=$PIECE($$GET1^DIQ(90056.0205,CLIENS,.11,"E")," ")
+16 ;MRS:BAR*1.8*10 H2555
IF CLSTATUS=""
SET CLSTATUS=$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,2)),U,4)
+17 ;PRIMARY,SECONDARY,TERTIARY AS WELL AS THOSE 19,20,21 FORWARDED TO ADDITIONAL PAYER BAR*1.8*6 IM29637
IF (U_"1"_U_"2"_U_"3"_U_"19"_U_"20"_U_"21"_U)'[(U_CLSTATUS_U)
QUIT
+18 SET POSTAS=$$GET1^DIQ(90056.0205,CLIENS,501,"I")
+19 IF POSTAS=138!(POSTAS=139)
QUIT
+20 ;BAR*1.8*6 SCR119
DO NONPAY(ERACHECK,IMPDA,CLMDA,BPR02)
End DoDot:1
+21 QUIT
NONPAY(ERACHECK,IMPDA,CLMDA,BPR02) ;EP - SEE IF TDN/IPAC = NONPAYMENT ;BAR*1.8*6 SCR119 IHS/SD/TPF
+1 ;P.OTT
NEW TDNIPAC,BARCOLDA,ERRORS,BARITMDA,NONPAY,NOITEM,NOHEAD,BARXCHK
+2 ;P.OTT
SET BARXCHK=$$BARXCHK^BAREDP09(ERACHECK)
+3 SET (NOITEM,NOHEAD,NONPAY)=0
+4 SET BARCOLDA=$ORDER(^BARCOL(DUZ(2),"D",BARXCHK,""))
+5 ;BAR*1.8*6 SCR119
IF 'BARCOLDA
IF (BPR02=0)
QUIT
+6 IF 'BARCOLDA
Begin DoDot:1
+7 ;NO BATCH FOUND FOR ERA CHECK
SET ERRORS("NB")=""
+8 DO ADDREAS^BAREDP04(IMPDA,CLMDA,.ERRORS)
+9 KILL ERRORS
End DoDot:1
QUIT
+10 ;CHECK ALL ERACHECK BATCHES/ITEMS FOR A NONPAYMENT
+11 NEW BARTODAY,%H
+12 ;GET $H-FORMAT
SET X=DT
DO H^%DTC
+13 SET BARTODAY=%H
+14 SET BARCOLDA=""
FOR
SET BARCOLDA=$ORDER(^BARCOL(DUZ(2),"D",BARXCHK,BARCOLDA))
IF BARCOLDA=""
QUIT
Begin DoDot:1
+15 NEW X,BARCBDT,BARCB
+16 SET X=$$GET1^DIQ(90051.01,BARCOLDA_",",4,"I")
+17 ;GET $H-FORMAT
DO H^%DTC
+18 SET BARCBDT=%H
+19 ;TOO OLD
IF BARTODAY-BARCBDT>365
Begin DoDot:2
+20 SET BARCB=$$GET1^DIQ(90051.01,BARCOLDA_",",.01,"A")
+21 SET BARMSG="IGNORING COLL. BATCH "_BARCB_" EIN# "_BARCOLDA_" TOO OLD: ("_X_")"
+22 DO INS^BAR50DET(BARMSG,0)
End DoDot:2
QUIT
+23 SET TDNIPAC=$$GET1^DIQ(90051.01,BARCOLDA_",",28,"E")
+24 IF TDNIPAC=""
SET NOHEAD=1
+25 IF TDNIPAC'=""&(TDNIPAC'="NONPAYMENT")
QUIT
+26 IF TDNIPAC="NONPAYMENT"
IF (CLMPYMT'=0)
Begin DoDot:2
+27 SET ERRORS("P NP")=""
+28 ;COL LEVEL
IF $GET(BARDBG)
DO DETAILS(0)
+29 QUIT
End DoDot:2
QUIT
+30 SET BARITMDA=""
SET BARITMDA=$ORDER(^BARCOL(DUZ(2),"D",BARXCHK,BARCOLDA,BARITMDA))
IF BARITMDA=""
QUIT
Begin DoDot:2
+31 SET TDNIPAC=$$GET1^DIQ(90051.1101,BARITMDA_","_BARCOLDA_",",20,"E")
+32 IF TDNIPAC=""
SET NOITEM=1
+33 IF TDNIPAC="NONPAYMENT"
IF (CLMPYMT'=0)
Begin DoDot:3
+34 SET ERRORS("P NP")=""
+35 ;DATAIL LEVEL
IF $GET(BARDBG)
DO DETAILS(1)
+36 QUIT
End DoDot:3
QUIT
End DoDot:2
+37 ;IF THERE ARE NO TDN FOR BOTH TOP LEVEL AND ITEM LEVEL THEN THIS IS ONE WITH MISSING TDN
+38 ;ONE OR THE OTHER HAS TO BE POPULATED
+39 IF NOITEM
IF NOHEAD
Begin DoDot:2
+40 ;2/4/2014 NOT FOR TRIBAL SITES - BAR*1.8*24
IF '$$IHS^BARUFUT(DUZ(2))
QUIT
+41 ;TDN/IPAC MISSING IN RPMS BATCH AND ITEM
SET ERRORS("NIPAC")=""
+42 ;NEW BARMSG
+43 ;I $G(BARDBG) D
+44 ;. S BARMSG="BATCH "_BARCOLD_" PROBLEM WITH ERA CHECK: "_ERACHECK_" NO TDN FOR BOTH TOP LEVEL AND ITEM LEVEL"
+45 ;. D INS^BAR50DET(BARMSG,0) ;10/10/2013
End DoDot:2
+46 SET (NOITEM,NOHEAD)=0
End DoDot:1
+47 IF $DATA(ERRORS)
Begin DoDot:1
+48 ;I $G(BARDBG) D
+49 ;. S BARMSG="PROBLEM WITH ERA CHECK: "_ERACHECK D INS^BAR50DET(BARMSG,0) ;10/10/13
+50 ;. D SHOWERR
+51 DO ADDREAS^BAREDP04(IMPDA,CLMDA,.ERRORS)
+52 KILL ERRORS
End DoDot:1
+53 QUIT
+54 ;
OVERIDE(X) ;EP; EXTRINSIC FUNCTION TO CHECK FOR OVERRIDES MRS:BAR*1.8*10 D159-2
+1 ; ENTERS WITH X = CLAIM IEN
+2 NEW BAROR,I
+3 ;NOT AN OVERRIDE
SET BAROR=0
+4 ;NODE 44 = USER STATUS OVVERRIDE
+5 ; 45 = PLB CHECK
+6 ; 46 = REVERSAL
+7 ; 47 = NEGATIVE PAYMENT
+8 FOR I=44:1:47
IF $DATA(^BAREDI("I",DUZ(2),IMPDA,30,X,4,"B",I))
Begin DoDot:1
+9 IF I=44
SET BAROR="1^USER STATUS OVERRIDE"
QUIT
+10 IF I=45
SET BAROR="1^PLB CHECK"
QUIT
+11 ; I I=46 S BAROR="1^REVERSAL" Q ;IHS/DIT/CPC - 20180514 CR9572 Recheck reversals - BAR*1.8*28
+12 ; I I=47 S BAROR="1^NEGATIVE PAYMENT" Q ;IHS/DIT/CPC - 20180514 CR9572 Recheck neg pymnt - BAR*1.8*28
End DoDot:1
+13 QUIT BAROR
DETAILS(BARLEVEL) ;
+1 ;DROPPED - BAR*1.8*24
QUIT
+2 SET BARMSG="ERA CHK#: "_ERACHECK
IF ERACHECK'=BARXCHK
SET BARMSG=BARMSG_" (A/R CHK# "_BARXCHK_")"
+3 SET BARMSG=BARMSG_" COLL DA: "_BARCOLDA
+4 SET BARMSG=BARMSG_" ERA PAYMENT: "_CLMPYMT
+5 DO INS^BAR50DET(BARMSG,0)
+6 IF BARLEVEL=1
SET BARMSG=" ITEM#: "_BARITMDA
DO INS^BAR50DET(BARMSG,0)
+7 SET BARMSG="ERR CODE(S): "
+8 IF $DATA(ERRORS("P NP"))
SET BARMSG=BARMSG_"P NP"
+9 IF $DATA(ERRORS("NEGP"))
SET BARMSG=BARMSG_"; NEGP"
+10 DO INS^BAR50DET(BARMSG,0)
+11 QUIT
SHOWERR ;DROPPED - BAR*1.8*24
+1 NEW I,J,BARTMP
+2 SET BARTMP=""
SET I=""
FOR
SET I=$ORDER(ERRORS(I))
IF I=""
QUIT
SET J=""
FOR
SET J=$ORDER(^BARERR("B",I,J))
IF J=""
QUIT
Begin DoDot:1
+3 SET BARMSG=$PIECE($GET(^BARERR(J,0)),U,2)
+4 DO INS^BAR50DET(BARMSG,0)
End DoDot:1
+5 ;EOR
QUIT
