BAR50EP1.m

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