BAREDP11.m

BAREDP11 ; IHS/SD/LSL - NEW REPORT ERA CLAIMS (2) ;

 ;;1.8;IHS ACCOUNTS RECEIVABLE;**3,5,20,23**;OCT 26, 2005

 ;

 ; IHS/SD/LSL - 10/14/03 - V1.7 Patch 4 - HIPAA

 ;      Routine Created

 ; ;P.OTT 10/28/2013 DON'T DISPLAY 'REASON NOT POSTABLE' IF MATCHED

 ; ********************************************************************

 ;

COMPUTE ;EP

 ; Compute line tag required by BARDBQUE but all processing

 ; is done under PRINT so just quit here

 Q

 ; ********************************************************************

 ;

PRINT ; EP

 ; PRINT the report (Browse or Print)

 S BAR("PG")=0

 I (BARTYP="D"!(BARTYP="B")) D DETAIL

 I BARTYP="S" D SUMMARY

 I $G(BAR("F1"))="" D

 . W !,$$CJ^XLFSTR("* * E N D   O F   R E P O R T * *",IOM)

 . D PAZ^BARRUTL

 D CLEANUP

 Q

 ; ********************************************************************

 ;

HD ; EP

 D PAZ^BARRUTL

 I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) S BAR("F1")=1 Q

 ; -------------------------------

 ;

HDB ; EP

 S BAR("PG")=BAR("PG")+1

 I BAR("PG")>1 S BAR("LVL")=4

 D WHD^BARRHD

 I BARTYP="S" D

 . X BAR("COL")

 . W !,BARDASH,!

 Q

 ; ********************************************************************

 ;

DETAIL ;

 ; Print report in brief and detail format

 D HDB

 K BARFLG  ;bar*1.8*20

 F XI=1:1:$L(BARINDX) S IND=$E(BARINDX,XI) D INDEX Q:$G(BAR("F1"))

 ;start new code bar*1.8*20

 I $D(^XTMP("BAR-ERARPT",$J,DUZ(2))) D

 .W !!,$$EN^BARVDF("RVN"),$$CJ^XLFSTR(BARZ("W","HDR"),IOM),!

 .W $$EN^BARVDF("RVF")

 .S CLMDA=0,BARFLG=1,(BARXBLC,BARXBLT,BARXPYT,BARXADJT)=0

 .F  S CLMDA=$O(^XTMP("BAR-ERARPT",$J,DUZ(2),CLMDA)) Q:CLMDA'>0  D CLAIM  Q:$G(BAR("F1"))

 .Q:$G(BAR("F1"))

 .K ^XTMP("BAR-ERARPT",$J)

 .I BARXBLC=0 W !!,$$CJ^XLFSTR("* * * NO DATA TO PRINT * * *",IOM),! Q

 .I $Y>(IOSL-5) D HD Q:$G(BAR("F1"))

 .W !,BARSTAR

 .W !,"TOTALS FOR ",BARZ("W")

 .W !?2,"AMOUNT BILLED.........."

 .W $J($FN(BARXBLC,","),6)," BILLS(S)"

 .W "     $",$J($FN(BARXBLT,",",2),15)

 .W !?2,"PAYMENTS..............."

 .W $J($FN(BARXPYC,","),6)," BILLS(S)"

 .W "     $",$J($FN(BARXPYT,",",2),15)

 .W !?2,"ADJUSTMENTS............"

 .W $J($FN(BARXADJC,","),6)," BILLS(S)"

 .W ?58,"$",$J($FN(BARXADJT,",",2),15)

 .W !

 ;end new code bar*1.8*20

 Q

 ; *********************************************************************

 ;

INDEX ; EP

 I $Y>(IOSL-5) D HD Q:$G(BAR("F1"))

 W !!,$$EN^BARVDF("RVN"),$$CJ^XLFSTR(BARZ(IND,"HDR"),IOM),!

 W $$EN^BARVDF("RVF")

 S (BARXPYT,BARXBLT,BARXADJT)=0

 S (BARXPYC,BARXBLC,BARXADJC)=0

 S BARFIRST=1

 S CLMDA=0

 F  S CLMDA=$O(^BAREDI("I",DUZ(2),IMPDA,30,"AC",IND,CLMDA)) Q:CLMDA'>0  D CLAIM  Q:$G(BAR("F1"))

 Q:$G(BAR("F1"))

 I BARXBLC=0 W !!,$$CJ^XLFSTR("* * * NO DATA TO PRINT * * *",IOM),! Q

 I $Y>(IOSL-5) D HD Q:$G(BAR("F1"))

 W !,BARSTAR

 W !,"TOTALS FOR ",BARZ(IND)

 W !?2,"AMOUNT BILLED.........."

 W $J($FN(BARXBLC,","),6)," BILLS(S)"

 W "     $",$J($FN(BARXBLT,",",2),15)

 W !?2,"PAYMENTS..............."

 W $J($FN(BARXPYC,","),6)," BILLS(S)"

 W "     $",$J($FN(BARXPYT,",",2),15)

 W !?2,"ADJUSTMENTS............"

 W $J($FN(BARXADJC,","),6)," BILLS(S)"

 W ?58,"$",$J($FN(BARXADJT,",",2),15)

 W !

 I $G(INDSAVE)'="" S IND=INDSAVE K INDSAVE  ;bar*1.8*20

 Q

 ; ********************************************************************

 ;

CLAIM ; EP

 ; WORK THE CLAIM

 K CLM

 I $P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,2)),U)'=BARCHK Q

 I '$G(BARFLG),IND="M",$D(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,4)) S ^XTMP("BAR-ERARPT",$J,DUZ(2),CLMDA)="" Q  ;bar*1.8*20

 D ENP^XBDIQ1(90056.0205,"IMPDA,CLMDA",".01:.09","CLM(")

 ;S BARERRC=$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,2)),U,4)  ;OLD 'CLAIM STATUS #204'  ;bar*1.8*20

 S BARERRC=$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,2)  ;bar*1.8*20

 S BARERRCD=""

 I +BARERRC S BARERRCD=$$GET1^DIQ(90056.21,BARERRC,.02)  ;ERROR CODE FROM 'A/R EDI EDI ERROR CODES'

 ; Billed amount totals for this index

 I +CLM(.05) D

 . S BARXBLC=BARXBLC+1

 . S BARXBLT=BARXBLT+CLM(.05)

 ; Payment amount totals for this index

 I +CLM(.04) D

 . S BARXPYC=BARXPYC+1

 . S BARXPYT=BARXPYT+CLM(.04)

 ; Write RA patient data

 I $Y>(IOSL-5) D HD Q:$G(BAR("F1"))

 I BARTYP="D",'BARFIRST W !,BARDASH

 S BARFIRST=0

 I $Y>(IOSL-5) D HD Q:$G(BAR("F1"))

 W !,$E(CLM(.01),1,18)  ;RA bill number

 W ?19,$E(CLM(.06),1,29)  ;RA patient name

 W ?49,CLM(.08)  ;RA dos begin

 W ?62,"- ",$E($P(CLM(.07)," ",3,999),1,15)  ;RA HRN/HIC

 I $Y>(IOSL-5) D HD Q:$G(BAR("F1"))

 ;W !,"  ** BILL NOT MATCHED TO RPMS "

 ;I BARERRCD]"" W "- ",BARERRCD," "

 ;IHS/SD/TPF BAR*1.8*3 UFMS SESSION 

 ;I BARERRCD]"",(BARERRCD'="MATCHED") W !,"-  ** BILL NOT MATCHED TO RPMS ",!,"(OLD) REASON: ",BARERRCD

 ;E  W !,"- Matched: "

 ;END IHS/SD/TPF BAR*1.8*3 UFMS SESSION

 ;BEGIN BAR*1.8*5 SRS-80 IHS/SD/TPF 4/15/2008 NEW ERRORS CAN BE MULTIPLE

 ;start old bar*1.8*20

 ;I $O(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,4,0)),(BARERRCD'="MATCHED") D

 ;.N REASDA,REASIENS,REASON

 ;.W !,"-  ** BILL NOT MATCHED TO RPMS "

 ;.W !?4,"REASON NOT MATCHED: "

 ;.S REASDA=0

 ;.F  S REASDA=$O(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,4,REASDA)) Q:'REASDA  D

 ;..S REASIENS=REASDA_","_CLMDA_","_IMPDA_","

 ;..S REASON=$$GET1^DIQ(90056.0205401,REASIENS,.01,"I")

 ;..S REASON=$$GET1^DIQ(90056.21,REASON_",",.02,"E")

 ;..W !?6,REASON

 ;.K REASDA,REASIENS,REASON

 ;.W !,"-  **"

 ;E  W !,"- Matched: "

 ;end old start new bar*1.8*20

 I BARERRC'="M",BARERRC'="P" D

 .W !,"-  ** BILL NOT MATCHED TO RPMS "

 N REASDA,REASIENS,REASON

 ;;;I (BARERRC'="P"),$D(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,4)) D

 I (BARERRC'="M"),(BARERRC'="P"),$D(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,4)) D  ;P.OTT 10/28/2013

 .W !?4,"REASON NOT POSTABLE: "

 .S REASDA=0

 .F  S REASDA=$O(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,4,REASDA)) Q:'REASDA  D

 ..S REASIENS=REASDA_","_CLMDA_","_IMPDA_","

 ..S REASON=$$GET1^DIQ(90056.0205401,REASIENS,.01,"I")

 ..S REASON=$$GET1^DIQ(90056.21,REASON_",",.02,"E")

 ..W !?6,REASON

 K REASDA,REASIENS,REASON

 ;W !,"-  **"  ;bar*1.8*20

 I BARERRC="M" S BARMIEN=CLMDA_","_IMPDA_"," W !,"- Matched: "_$$GET1^DIQ(90056.0205,BARMIEN,"1.01","E")

 ;end new bar*1.8*20

 ;W "**"

 ;END 

 I BARTYP="D" D  Q:$G(BAR("F1"))

 . I $Y>(IOSL-5) D HD Q:$G(BAR("F1"))

 . W !!,"AMOUNT BILLED.............................................$",$J($FN(CLM(.05),",",2),15)

 . I $Y>(IOSL-5) D HD Q:$G(BAR("F1"))

 . W !,"PAYMENT...................................................$",$J($FN(CLM(.04),",",2),15)

 D ADJ

 Q

 ; ********************************************************************

 ;

ADJ ;

 ; Loop adjustment data on claim

 K ADJ

 Q:'+$O(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,30,0))    ; No adjustments

 S BARXADJC=BARXADJC+1

 I BARTYP="D" D  Q:$G(BAR("F1"))

 . I $Y>(IOSL-5) D HD Q:$G(BAR("F1"))

 . W !,"ADJUSTMENTS"

 S ADJDA=0

 F  S ADJDA=$O(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,30,ADJDA)) Q:'+ADJDA  D ADJ2 Q:$G(BAR("F1"))

 Q:$G(BAR("F1"))

 Q

 ; ********************************************************************

 ;

ADJ2 ;

 ; 

 Q:'$D(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,30,ADJDA,0))

 D ENP^XBDIQ1(90056.0208,"IMPDA,CLMDA,ADJDA,",".01:.05","ADJ(")

 S BARADJ(0)=$G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,30,ADJDA,0))

 S BARXADJT=BARXADJT+ADJ(.02)

 I BARTYP="D" D  Q:$G(BAR("F1"))       ; If detail, write specifics

 . I $Y>(IOSL-5) D HD Q:$G(BAR("F1"))

 . W !?2,$J($P(ADJ(.01)," "),2)        ; Standard adj code

 . D PAD

 . W ?6,ADJ(.03)                       ; Standard adj description

 . W ?53,"$",$J($FN(ADJ(.02),",",2),10)    ; Adj amount

 . I $Y>(IOSL-5) D HD Q:$G(BAR("F1"))

 . W !?6,$J($P(BARADJ(0),U,4),3)       ; RPMS Category

 . W ?10,$E(ADJ(.04),1,19)             ; RPMS Category Description

 . W ?30,"/"

 . W ?32,$J($P(BARADJ(0),U,5),3)       ; RPMS Reason Code

 . W ?36,$E(ADJ(.05),1,30)             ; RPMS Reason Description

 Q

 ; ********************************************************************

 ;

PAD ;

 ; Standard Adj Description must be 47 characters

 K L,I,K

 S K=$P(ADJ(.03)," ",3,999)

 S L=$L(K)

 I L>45 S K=$E(K,1,46)

 I L<46 D

 . F I=L:1:46 S K=K_"."

 S ADJ(.03)=K

 K L,I,K

 Q

 ; ********************************************************************

 ;

SUMMARY ;

 D SUMDATA

 I '$D(BARX) D  Q

 . D HDB

 . W !!!,$$CJ^XLFSTR("* * * NO DATA TO PRINT * * *",IOM)

 . D PAZ^BARRUTL

 D SUMPRINT

 Q

 ; ********************************************************************

 ;

SUMDATA ;

 ;

 S BAR("COL")="W !,""CLAIM STATUS"",?26,""BILL COUNT"",?40,""PAYMENTS"",?51,""COPAY/DEDUCT"",?66,""ADJUSTMENTS"""

 K BARA

 F XI=1:1:$L(BARINDX) S BARX($E(BARINDX,XI))=0

 S BARX=0

 F XI=1:1:$L(BARINDX) S IND=$E(BARINDX,XI) D SUMDATA2

 Q

 ; ********************************************************************

 ;

SUMDATA2 ;

 ;

 S CLMDA=0

 F  S CLMDA=$O(^BAREDI("I",DUZ(2),IMPDA,30,"AC",IND,CLMDA)) Q:CLMDA'>0  D SUMDATA3

 Q

 ; ********************************************************************

 ;

SUMDATA3 ;

 K CLM

 Q:'$D(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0))    ; No data

 I $P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,2)),U)'=BARCHK Q

 D ENP^XBDIQ1(90056.0205,"IMPDA,CLMDA",".01:.09","CLM(")

 S $P(BARX(IND),U)=$P($G(BARX(IND)),U)+1        ; Bill count per index

 S $P(BARX(IND),U,2)=$P($G(BARX(IND)),U,2)+CLM(.04)   ; Payment

 S $P(BARX,U)=$P($G(BARX),U)+1              ; Total bill count

 S $P(BARX,U,2)=$P($G(BARX),U,2)+CLM(.04)   ; Total payments

 S ADJDA=0

 F  S ADJDA=$O(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,30,ADJDA)) Q:'+ADJDA  D SUMDATA4

 Q

 ; ********************************************************************

 ;

SUMDATA4 ;

 ;

 Q:'$D(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,30,ADJDA,0))    ; No data

 S BARADJ0=$G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,30,ADJDA,0))

 I ($P(BARADJ0,U,4)=13!($P(BARADJ0,U,4)=14)) D

 . S $P(BARX(IND),U,3)=$P($G(BARX(IND)),U,3)+$P(BARADJ0,U,2)

 . S $P(BARX,U,3)=$P($G(BARX),U,3)+$P(BARADJ0,U,2)

 E  D

 . S $P(BARX(IND),U,4)=$P($G(BARX(IND)),U,4)+$P(BARADJ0,U,2)

 . S $P(BARX,U,4)=$P($G(BARX),U,4)+$P(BARADJ0,U,2)

 ;S BARA($P(BARADJ0,U,4))=$G(BARA($P(BARADJ0,U,4)))+$P(BARADJ0,U,2)

 I $P(BARADJ0,U,4)'="" S BARA($P(BARADJ0,U,4))=$G(BARA($P(BARADJ0,U,4)))+$P(BARADJ0,U,2)  ;BAR*1.8*5 SRS-80 IHS/SD/TPF 4/15/2008 FOUND DURING DEVELOPMENT

 S BARA=$G(BARA)+$P(BARADJ0,U,2)

 Q

 ; ********************************************************************

 ;

SUMPRINT ;

 ;

 D HDB

 S IND=""

 F  S IND=$O(BARX(IND)) Q:IND=""  D  Q:$G(BAR("F1"))

 . I $Y>(IOSL-5) D HD Q:$G(BAR("F1"))

 . W !,BARZ(IND)

 . W ?26,$J($P(BARX(IND),U),6)

 . W ?35,$J($FN($P(BARX(IND),U,2),",",2),12)

 . W ?50,$J($FN($P(BARX(IND),U,3),",",2),12)

 . W ?65,$J($FN($P(BARX(IND),U,4),",",2),12)

 I $Y>(IOSL-5) D HD Q:$G(BAR("F1"))

 W !?26,"------",?35,"------------",?50,"------------",?65,"------------"

 I $Y>(IOSL-5) D HD Q:$G(BAR("F1"))

 W !?3,"GRAND TOTALS"

 W ?26,$J($P(BARX,U),6)

 W ?35,$J($FN($P(BARX,U,2),",",2),12)

 W ?50,$J($FN($P(BARX,U,3),",",2),12)

 W ?65,$J($FN($P(BARX,U,4),",",2),12)

 I '$D(BARA) W !! Q

 ; Adjustment summary

 I $Y>(IOSL-5) D HD Q:$G(BAR("F1"))

 W !!?10,"ADJUSTMENT Totals:",!

 I $Y>(IOSL-5) D HD Q:$G(BAR("F1"))  W !

 ; List copay AND deduct first

 F I=13,14 D  Q:$G(BAR("F1"))

 . I $D(BARA(I)) D  Q:$G(BAR("F1"))

 . . W ?15,$$GET1^DIQ(90052.01,I,.01)

 . . W ?50,$J($FN(BARA(I),",",2),12)

 . . W !

 . . K BARA(I)

 . . I $Y>(IOSL-5) D HD Q:$G(BAR("F1"))

 ; loop the rest

 S I=0

 F  S I=$O(BARA(I)) Q:'+I  D

 . W ?15,$$GET1^DIQ(90052.01,I,.01)

 . W ?50,$J($FN(BARA(I),",",2),12)

 . W !

 . I $Y>(IOSL-5) D HD Q:$G(BAR("F1"))

 W ?50,"============",!

 I $Y>(IOSL-5) D HD Q:$G(BAR("F1"))

 W ?50,$J($FN(BARA,",",2),12),!

 Q

 ; ********************************************************************

 ;

CLEANUP ;

 K IMPDA,CLMDA,ADJDA,TRDA,I,J,K,DA,DR,DIC,DIE,CLM,ADJ

 Q

BAREDP11  ; IHS/SD/LSL - NEW REPORT ERA CLAIMS (2) ;

 +1       ;;1.8;IHS ACCOUNTS RECEIVABLE;**3,5,20,23**;OCT 26, 2005

 +2       ;

 +3       ; IHS/SD/LSL - 10/14/03 - V1.7 Patch 4 - HIPAA

 +4       ;      Routine Created

 +5       ; ;P.OTT 10/28/2013 DON'T DISPLAY 'REASON NOT POSTABLE' IF MATCHED

 +6       ; ********************************************************************

 +7       ;

COMPUTE   ;EP

 +1       ; Compute line tag required by BARDBQUE but all processing

 +2       ; is done under PRINT so just quit here

 +3        QUIT 

 +4       ; ********************************************************************

 +5       ;

PRINT     ; EP

 +1       ; PRINT the report (Browse or Print)

 +2        SET BAR("PG")=0

 +3        IF (BARTYP="D"!(BARTYP="B"))

               DO DETAIL

 +4        IF BARTYP="S"

               DO SUMMARY

 +5        IF $GET(BAR("F1"))=""

               Begin DoDot:1

 +6                WRITE !,$$CJ^XLFSTR("* * E N D   O F   R E P O R T * *",IOM)

 +7                DO PAZ^BARRUTL

               End DoDot:1

 +8        DO CLEANUP

 +9        QUIT 

 +10      ; ********************************************************************

 +11      ;

HD        ; EP

 +1        DO PAZ^BARRUTL

 +2        IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)

               SET BAR("F1")=1

               QUIT 

 +3       ; -------------------------------

 +4       ;

HDB       ; EP

 +1        SET BAR("PG")=BAR("PG")+1

 +2        IF BAR("PG")>1

               SET BAR("LVL")=4

 +3        DO WHD^BARRHD

 +4        IF BARTYP="S"

               Begin DoDot:1

 +5                XECUTE BAR("COL")

 +6                WRITE !,BARDASH,!

               End DoDot:1

 +7        QUIT 

 +8       ; ********************************************************************

 +9       ;

DETAIL    ;

 +1       ; Print report in brief and detail format

 +2        DO HDB

 +3       ;bar*1.8*20

           KILL BARFLG

 +4        FOR XI=1:1:$LENGTH(BARINDX)

               SET IND=$EXTRACT(BARINDX,XI)

               DO INDEX

               IF $GET(BAR("F1"))

                   QUIT 

 +5       ;start new code bar*1.8*20

 +6        IF $DATA(^XTMP("BAR-ERARPT",$JOB,DUZ(2)))

               Begin DoDot:1

 +7                WRITE !!,$$EN^BARVDF("RVN"),$$CJ^XLFSTR(BARZ("W","HDR"),IOM),!

 +8                WRITE $$EN^BARVDF("RVF")

 +9                SET CLMDA=0

                   SET BARFLG=1

                   SET (BARXBLC,BARXBLT,BARXPYT,BARXADJT)=0

 +10               FOR 

                       SET CLMDA=$ORDER(^XTMP("BAR-ERARPT",$JOB,DUZ(2),CLMDA))

                       IF CLMDA'>0

                           QUIT 

                       DO CLAIM

                       IF $GET(BAR("F1"))

                           QUIT 

 +11               IF $GET(BAR("F1"))

                       QUIT 

 +12               KILL ^XTMP("BAR-ERARPT",$JOB)

 +13               IF BARXBLC=0

                       WRITE !!,$$CJ^XLFSTR("* * * NO DATA TO PRINT * * *",IOM),!

                       QUIT 

 +14               IF $Y>(IOSL-5)

                       DO HD

                       IF $GET(BAR("F1"))

                           QUIT 

 +15               WRITE !,BARSTAR

 +16               WRITE !,"TOTALS FOR ",BARZ("W")

 +17               WRITE !?2,"AMOUNT BILLED.........."

 +18               WRITE $JUSTIFY($FNUMBER(BARXBLC,","),6)," BILLS(S)"

 +19               WRITE "     $",$JUSTIFY($FNUMBER(BARXBLT,",",2),15)

 +20               WRITE !?2,"PAYMENTS..............."

 +21               WRITE $JUSTIFY($FNUMBER(BARXPYC,","),6)," BILLS(S)"

 +22               WRITE "     $",$JUSTIFY($FNUMBER(BARXPYT,",",2),15)

 +23               WRITE !?2,"ADJUSTMENTS............"

 +24               WRITE $JUSTIFY($FNUMBER(BARXADJC,","),6)," BILLS(S)"

 +25               WRITE ?58,"$",$JUSTIFY($FNUMBER(BARXADJT,",",2),15)

 +26               WRITE !

               End DoDot:1

 +27      ;end new code bar*1.8*20

 +28       QUIT 

 +29      ; *********************************************************************

 +30      ;

INDEX     ; EP

 +1        IF $Y>(IOSL-5)

               DO HD

               IF $GET(BAR("F1"))

                   QUIT 

 +2        WRITE !!,$$EN^BARVDF("RVN"),$$CJ^XLFSTR(BARZ(IND,"HDR"),IOM),!

 +3        WRITE $$EN^BARVDF("RVF")

 +4        SET (BARXPYT,BARXBLT,BARXADJT)=0

 +5        SET (BARXPYC,BARXBLC,BARXADJC)=0

 +6        SET BARFIRST=1

 +7        SET CLMDA=0

 +8        FOR 

               SET CLMDA=$ORDER(^BAREDI("I",DUZ(2),IMPDA,30,"AC",IND,CLMDA))

               IF CLMDA'>0

                   QUIT 

               DO CLAIM

               IF $GET(BAR("F1"))

                   QUIT 

 +9        IF $GET(BAR("F1"))

               QUIT 

 +10       IF BARXBLC=0

               WRITE !!,$$CJ^XLFSTR("* * * NO DATA TO PRINT * * *",IOM),!

               QUIT 

 +11       IF $Y>(IOSL-5)

               DO HD

               IF $GET(BAR("F1"))

                   QUIT 

 +12       WRITE !,BARSTAR

 +13       WRITE !,"TOTALS FOR ",BARZ(IND)

 +14       WRITE !?2,"AMOUNT BILLED.........."

 +15       WRITE $JUSTIFY($FNUMBER(BARXBLC,","),6)," BILLS(S)"

 +16       WRITE "     $",$JUSTIFY($FNUMBER(BARXBLT,",",2),15)

 +17       WRITE !?2,"PAYMENTS..............."

 +18       WRITE $JUSTIFY($FNUMBER(BARXPYC,","),6)," BILLS(S)"

 +19       WRITE "     $",$JUSTIFY($FNUMBER(BARXPYT,",",2),15)

 +20       WRITE !?2,"ADJUSTMENTS............"

 +21       WRITE $JUSTIFY($FNUMBER(BARXADJC,","),6)," BILLS(S)"

 +22       WRITE ?58,"$",$JUSTIFY($FNUMBER(BARXADJT,",",2),15)

 +23       WRITE !

 +24      ;bar*1.8*20

           IF $GET(INDSAVE)'=""

               SET IND=INDSAVE

               KILL INDSAVE

 +25       QUIT 

 +26      ; ********************************************************************

 +27      ;

CLAIM     ; EP

 +1       ; WORK THE CLAIM

 +2        KILL CLM

 +3        IF $PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,2)),U)'=BARCHK

               QUIT 

 +4       ;bar*1.8*20

           IF '$GET(BARFLG)

               IF IND="M"

                   IF $DATA(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,4))

                       SET ^XTMP("BAR-ERARPT",$JOB,DUZ(2),CLMDA)=""

                       QUIT 

 +5        DO ENP^XBDIQ1(90056.0205,"IMPDA,CLMDA",".01:.09","CLM(")

 +6       ;S BARERRC=$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,2)),U,4)  ;OLD 'CLAIM STATUS #204'  ;bar*1.8*20

 +7       ;bar*1.8*20

           SET BARERRC=$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,2)

 +8        SET BARERRCD=""

 +9       ;ERROR CODE FROM 'A/R EDI EDI ERROR CODES'

           IF +BARERRC

               SET BARERRCD=$$GET1^DIQ(90056.21,BARERRC,.02)

 +10      ; Billed amount totals for this index

 +11       IF +CLM(.05)

               Begin DoDot:1

 +12               SET BARXBLC=BARXBLC+1

 +13               SET BARXBLT=BARXBLT+CLM(.05)

               End DoDot:1

 +14      ; Payment amount totals for this index

 +15       IF +CLM(.04)

               Begin DoDot:1

 +16               SET BARXPYC=BARXPYC+1

 +17               SET BARXPYT=BARXPYT+CLM(.04)

               End DoDot:1

 +18      ; Write RA patient data

 +19       IF $Y>(IOSL-5)

               DO HD

               IF $GET(BAR("F1"))

                   QUIT 

 +20       IF BARTYP="D"

               IF 'BARFIRST

                   WRITE !,BARDASH

 +21       SET BARFIRST=0

 +22       IF $Y>(IOSL-5)

               DO HD

               IF $GET(BAR("F1"))

                   QUIT 

 +23      ;RA bill number

           WRITE !,$EXTRACT(CLM(.01),1,18)

 +24      ;RA patient name

           WRITE ?19,$EXTRACT(CLM(.06),1,29)

 +25      ;RA dos begin

           WRITE ?49,CLM(.08)

 +26      ;RA HRN/HIC

           WRITE ?62,"- ",$EXTRACT($PIECE(CLM(.07)," ",3,999),1,15)

 +27       IF $Y>(IOSL-5)

               DO HD

               IF $GET(BAR("F1"))

                   QUIT 

 +28      ;W !,"  ** BILL NOT MATCHED TO RPMS "

 +29      ;I BARERRCD]"" W "- ",BARERRCD," "

 +30      ;IHS/SD/TPF BAR*1.8*3 UFMS SESSION 

 +31      ;I BARERRCD]"",(BARERRCD'="MATCHED") W !,"-  ** BILL NOT MATCHED TO RPMS ",!,"(OLD) REASON: ",BARERRCD

 +32      ;E  W !,"- Matched: "

 +33      ;END IHS/SD/TPF BAR*1.8*3 UFMS SESSION

 +34      ;BEGIN BAR*1.8*5 SRS-80 IHS/SD/TPF 4/15/2008 NEW ERRORS CAN BE MULTIPLE

 +35      ;start old bar*1.8*20

 +36      ;I $O(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,4,0)),(BARERRCD'="MATCHED") D

 +37      ;.N REASDA,REASIENS,REASON

 +38      ;.W !,"-  ** BILL NOT MATCHED TO RPMS "

 +39      ;.W !?4,"REASON NOT MATCHED: "

 +40      ;.S REASDA=0

 +41      ;.F  S REASDA=$O(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,4,REASDA)) Q:'REASDA  D

 +42      ;..S REASIENS=REASDA_","_CLMDA_","_IMPDA_","

 +43      ;..S REASON=$$GET1^DIQ(90056.0205401,REASIENS,.01,"I")

 +44      ;..S REASON=$$GET1^DIQ(90056.21,REASON_",",.02,"E")

 +45      ;..W !?6,REASON

 +46      ;.K REASDA,REASIENS,REASON

 +47      ;.W !,"-  **"

 +48      ;E  W !,"- Matched: "

 +49      ;end old start new bar*1.8*20

 +50       IF BARERRC'="M"

               IF BARERRC'="P"

                   Begin DoDot:1

 +51                   WRITE !,"-  ** BILL NOT MATCHED TO RPMS "

                   End DoDot:1

 +52       NEW REASDA,REASIENS,REASON

 +53      ;;;I (BARERRC'="P"),$D(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,4)) D

 +54      ;P.OTT 10/28/2013

           IF (BARERRC'="M")

               IF (BARERRC'="P")

                   IF $DATA(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,4))

                       Begin DoDot:1

 +55                       WRITE !?4,"REASON NOT POSTABLE: "

 +56                       SET REASDA=0

 +57                       FOR 

                               SET REASDA=$ORDER(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,4,REASDA))

                               IF 'REASDA

                                   QUIT 

                               Begin DoDot:2

 +58                               SET REASIENS=REASDA_","_CLMDA_","_IMPDA_","

 +59                               SET REASON=$$GET1^DIQ(90056.0205401,REASIENS,.01,"I")

 +60                               SET REASON=$$GET1^DIQ(90056.21,REASON_",",.02,"E")

 +61                               WRITE !?6,REASON

                               End DoDot:2

                       End DoDot:1

 +62       KILL REASDA,REASIENS,REASON

 +63      ;W !,"-  **"  ;bar*1.8*20

 +64       IF BARERRC="M"

               SET BARMIEN=CLMDA_","_IMPDA_","

               WRITE !,"- Matched: "_$$GET1^DIQ(90056.0205,BARMIEN,"1.01","E")

 +65      ;end new bar*1.8*20

 +66      ;W "**"

 +67      ;END 

 +68       IF BARTYP="D"

               Begin DoDot:1

 +69               IF $Y>(IOSL-5)

                       DO HD

                       IF $GET(BAR("F1"))

                           QUIT 

 +70               WRITE !!,"AMOUNT BILLED.............................................$",$JUSTIFY($FNUMBER(CLM(.05),",",2),15)

 +71               IF $Y>(IOSL-5)

                       DO HD

                       IF $GET(BAR("F1"))

                           QUIT 

 +72               WRITE !,"PAYMENT...................................................$",$JUSTIFY($FNUMBER(CLM(.04),",",2),15)

               End DoDot:1

               IF $GET(BAR("F1"))

                   QUIT 

 +73       DO ADJ

 +74       QUIT 

 +75      ; ********************************************************************

 +76      ;

ADJ       ;

 +1       ; Loop adjustment data on claim

 +2        KILL ADJ

 +3       ; No adjustments

           IF '+$ORDER(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,30,0))

               QUIT 

 +4        SET BARXADJC=BARXADJC+1

 +5        IF BARTYP="D"

               Begin DoDot:1

 +6                IF $Y>(IOSL-5)

                       DO HD

                       IF $GET(BAR("F1"))

                           QUIT 

 +7                WRITE !,"ADJUSTMENTS"

               End DoDot:1

               IF $GET(BAR("F1"))

                   QUIT 

 +8        SET ADJDA=0

 +9        FOR 

               SET ADJDA=$ORDER(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,30,ADJDA))

               IF '+ADJDA

                   QUIT 

               DO ADJ2

               IF $GET(BAR("F1"))

                   QUIT 

 +10       IF $GET(BAR("F1"))

               QUIT 

 +11       QUIT 

 +12      ; ********************************************************************

 +13      ;

ADJ2      ;

 +1       ; 

 +2        IF '$DATA(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,30,ADJDA,0))

               QUIT 

 +3        DO ENP^XBDIQ1(90056.0208,"IMPDA,CLMDA,ADJDA,",".01:.05","ADJ(")

 +4        SET BARADJ(0)=$GET(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,30,ADJDA,0))