BAR50EP1 ; IHS/SD/TPF - AR ERA NONPAYMENT CHECKER ; 01/30/2009
;;1.8;IHS ACCOUNTS RECEIVABLE;**5,6,10,21,22,23,24,26**;OCT 26,2005;Build 17
;;P.OTTIS HEAT#82698 NOV 2012 LEADING ZEROES IN CHKECK # (POS)
;; FEB 13 ADDED INFO ON NONPAY DETAILS; SHOW CLMPYMT
;; MAR 13 EXCLUDED COL BATCHES OLDER THAN 365 DAYS
;P.OTTIS REFINED 'OVERRIDE' FLAG WITH MESSAGE
; 10/10/13 FIXED ERR MSG FOR ERROR=NIPAC
; DON'T DISPLAY ERR FOR MATCHED CLAIMS 11/27/13
;HEAT147572 P.OTT ALLOW TRIBAL SITES ERA POSTING OF NEG BAL
; 2/4/2014 BLOCK ERROR NIPAC (TDN/IPAC MISSING IN RPMS BATCH AND ITEM) FOR TRIBAL SITES
Q
NONPAYCH(IMPDA) ;EP - CHECK PAYMENTS NOT MATCHED WITH A REVERSAL
N CLMDA,ERACHECK,CLSTATUS,POSTAS,CNT,CLIENS
N BPR02
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:$$OVERIDE^BAR50EP1(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)
. 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
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 ;
I 'BARCOLDA D Q
. S ERRORS("NB")="" ;NO BATCH FOUND FOR ERA CHECK
. D ADDREAS^BAR50P04(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
. S BARITMDA="" F 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) ;DETAIL 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
. . S ERRORS("NIPAC")="" ;TDN/IPAC MISSING IN RPMS BATCH AND ITEM
. . NEW BARMSG
. . I $G(BARDBG) D
. . . S BARMSG="BATCH "_BARCOLDA_": 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
. NEW BARTMP,I
. I $G(BARDBG) D
. . S BARMSG="PROBLEM WITH ERA CHECK: "_ERACHECK D INS^BAR50DET(BARMSG,0) ;10/10/2013
. . D SHOWERR
. D ADDREAS^BAR50P04(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 ;bar*1.8*26 IHS/SD/SDR HEAT170856
.;I I=47 S BAROR="1^NEGATIVE PAYMENT" Q ;bar*1.8*26 IHS/SD/SDR HEAT170856
Q BAROR
DETAILS(BARLEVEL) ;
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 ;
NEW I,J,BARTMP,BARERRC
S BARERRC=$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,2) ;CLAIM STATUS
I BARERRC="M" QUIT ;DON'T DISPLAY ERR FOR MATCHED CLAIMS 11/27/13
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
BAR50EP1 ; IHS/SD/TPF - AR ERA NONPAYMENT CHECKER ; 01/30/2009
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**5,6,10,21,22,23,24,26**;OCT 26,2005;Build 17
+2 ;;P.OTTIS HEAT#82698 NOV 2012 LEADING ZEROES IN CHKECK # (POS)
+3 ;; FEB 13 ADDED INFO ON NONPAY DETAILS; SHOW CLMPYMT
+4 ;; MAR 13 EXCLUDED COL BATCHES OLDER THAN 365 DAYS
+5 ;P.OTTIS REFINED 'OVERRIDE' FLAG WITH MESSAGE
+6 ; 10/10/13 FIXED ERR MSG FOR ERROR=NIPAC
+7 ; DON'T DISPLAY ERR FOR MATCHED CLAIMS 11/27/13
+8 ;HEAT147572 P.OTT ALLOW TRIBAL SITES ERA POSTING OF NEG BAL
+9 ; 2/4/2014 BLOCK ERROR NIPAC (TDN/IPAC MISSING IN RPMS BATCH AND ITEM) FOR TRIBAL SITES
+10 QUIT
NONPAYCH(IMPDA) ;EP - CHECK PAYMENTS NOT MATCHED WITH A REVERSAL
+1 NEW CLMDA,ERACHECK,CLSTATUS,POSTAS,CNT,CLIENS
+2 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 ;MRS:BAR*1.8*10 D159-1 AND 2
IF $$OVERIDE^BAR50EP1(CLMDA)
QUIT
+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 SET CLIENS=CLMDA_","_IMPDA_","
+13 ;CHECK/EFT TRACE
SET ERACHECK=$$GET1^DIQ(90056.0205,CLIENS,201,"E")
+14 ;E-CLAIM STATUS CODE (CLP02)
SET CLSTATUS=$PIECE($$GET1^DIQ(90056.0205,CLIENS,.11,"E")," ")
+15 IF CLSTATUS=""
SET CLSTATUS=$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,2)),U,4)
+16 ;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
+17 SET POSTAS=$$GET1^DIQ(90056.0205,CLIENS,501,"I")
+18 IF POSTAS=138!(POSTAS=139)
QUIT
+19 ;BAR*1.8*6 SCR119
DO NONPAY(ERACHECK,IMPDA,CLMDA,BPR02)
End DoDot:1
+20 QUIT
NONPAY(ERACHECK,IMPDA,CLMDA,BPR02) ;EP - SEE IF TDN/IPAC = NONPAYMENT
+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 ;
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^BAR50P04(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 ;S BARMSG="IGNORING COLL. BATCH "_BARCB_" EIN# "_BARCOLDA_" TOO OLD: ("_X_")"
+22 ;D 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)
End DoDot:2
QUIT
+29 SET BARITMDA=""
FOR
SET BARITMDA=$ORDER(^BARCOL(DUZ(2),"D",BARXCHK,BARCOLDA,BARITMDA))
IF BARITMDA=""
QUIT
Begin DoDot:2
+30 SET TDNIPAC=$$GET1^DIQ(90051.1101,BARITMDA_","_BARCOLDA_",",20,"E")
+31 IF TDNIPAC=""
SET NOITEM=1
+32 IF TDNIPAC="NONPAYMENT"
IF (CLMPYMT'=0)
Begin DoDot:3
+33 SET ERRORS("P NP")=""
+34 ;DETAIL LEVEL
IF $GET(BARDBG)
DO DETAILS(1)
End DoDot:3
QUIT
+35 QUIT
End DoDot:2
+36 ;IF THERE ARE NO TDN FOR BOTH TOP LEVEL AND ITEM LEVEL THEN THIS IS ONE WITH MISSING TDN
+37 ;ONE OR THE OTHER HAS TO BE POPULATED
+38 IF NOITEM
IF NOHEAD
Begin DoDot:2
+39 ;2/4/2014 NOT FOR TRIBAL SITES
IF '$$IHS^BARUFUT(DUZ(2))
QUIT
+40 ;TDN/IPAC MISSING IN RPMS BATCH AND ITEM
SET ERRORS("NIPAC")=""
+41 NEW BARMSG
+42 IF $GET(BARDBG)
Begin DoDot:3
+43 SET BARMSG="BATCH "_BARCOLDA_": ERA CHECK: "_ERACHECK_" NO TDN FOR BOTH TOP LEVEL AND ITEM LEVEL"
+44 ;10/10/2013
DO INS^BAR50DET(BARMSG,0)
End DoDot:3
End DoDot:2
+45 SET (NOITEM,NOHEAD)=0
End DoDot:1
+46 IF $DATA(ERRORS)
Begin DoDot:1
+47 NEW BARTMP,I
+48 IF $GET(BARDBG)
Begin DoDot:2
+49 ;10/10/2013
SET BARMSG="PROBLEM WITH ERA CHECK: "_ERACHECK
DO INS^BAR50DET(BARMSG,0)
+50 DO SHOWERR
End DoDot:2
+51 DO ADDREAS^BAR50P04(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 ;bar*1.8*26 IHS/SD/SDR HEAT170856
+12 ;I I=47 S BAROR="1^NEGATIVE PAYMENT" Q ;bar*1.8*26 IHS/SD/SDR HEAT170856
End DoDot:1
+13 QUIT BAROR
DETAILS(BARLEVEL) ;
+1 SET BARMSG="ERA CHK#: "_ERACHECK
IF ERACHECK'=BARXCHK
SET BARMSG=BARMSG_" (A/R CHK# "_BARXCHK_")"
+2 SET BARMSG=BARMSG_" COLL DA: "_BARCOLDA
+3 SET BARMSG=BARMSG_" ERA PAYMENT: "_CLMPYMT
+4 DO INS^BAR50DET(BARMSG,0)
+5 IF BARLEVEL=1
SET BARMSG=" ITEM#: "_BARITMDA
DO INS^BAR50DET(BARMSG,0)
+6 SET BARMSG="ERR CODE(S): "
+7 IF $DATA(ERRORS("P NP"))
SET BARMSG=BARMSG_"P NP"
+8 IF $DATA(ERRORS("NEGP"))
SET BARMSG=BARMSG_"; NEGP"
+9 DO INS^BAR50DET(BARMSG,0)
+10 QUIT
SHOWERR ;
+1 NEW I,J,BARTMP,BARERRC
+2 ;CLAIM STATUS
SET BARERRC=$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,2)
+3 ;DON'T DISPLAY ERR FOR MATCHED CLAIMS 11/27/13
IF BARERRC="M"
QUIT
+4 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
+5 SET BARMSG=$PIECE($GET(^BARERR(J,0)),U,2)
+6 DO INS^BAR50DET(BARMSG,0)
End DoDot:1
+7 QUIT
