Routine: BARDMRE

BARDMRE ;IHS/OIT/FCJ - DEBT MANAGEMENT-ERROR REPORT ; 11 Jul 2012  1:34 PM

 ;;1.8;IHS ACCOUNTS RECEIVABLE;**22,23,24,27**;OCT 26, 2005;Build 12

 ;New routine 5-12-2011 for Debt Letter Management

 ;This report will provide letters ready to be printed by cycle, Insurer and detail

 ;IHS/SD/POT SEP 2012 IGNORE DUPLICATE BILL / NONEX CLAIM # (SAME LOGIC AS IN BARDMLP)

 ;IHS/SD/POT MAY 2013 FIXED COUNT OF 'L'ETTERS (LINE 64)- BAR*1.8*.23

 ;         FIXED <READ> ERRORS: MAKE CALL OF ^DIR CONDITIONAL- BAR*1.8*.23

 ;IHS/SD/POT MAY 2013 CHK / SET STATUS 'PAID'- BAR*1.8*.23

 ;IHS/SD/POT JULY 2013 P.OTT HEAT118656 BELCOURT: SKIP UNDEF ENTRY IN ^BARBL- BAR*1.8*.24

 ;IHS/SD/POT HEAT152452 2/10/2014 CHK IF PAR/SAT FILE CORECTLY SET UP - BAR*1.8*.24

 ;IHS/DIT/CPC New Medicare Card Initiative CR09275 11/3/2017 - BAR*1.8*27

ST ;

 S BMCQ=0,BARRPT="C",BARSEQ=0

 W !!,"Report for Errors in Letters to be printed"

 D PAR^BARDMU

 Q:$G(BARQ)  ;P.OTT HEAT152452 2/10/2014- BAR*1.8*.24

 D RRDT^BARDMU

 D ZIS

ZIS ;

 D ZIS^BARDMU

 G:$G(BARQUIT) XIT

 S XBRC="CALC^BARDMRE(1)",XBRX="XIT^BARDMRE",XBNS="BAR"

 I $G(BAROPT)="B" S XBRP="VIEWR^XBLM(""PRINT^BARDMRE"")",XBIOP=0

 E  S XBRP="PRINT^BARDMRE"

 D ^XBDBQUE

 D XIT

XIT ;

 K ^TMP("BARDME",$J)

 I $D(IO("S")) S IOP="`"_IOS D ^%ZIS Q

 D ^%ZISC

 K DIR,BARL,BARL1,BARL2,BARC,BARCT,BARCYCLE,BARTST  ;

CALC(BARCALL) ;

 ;BARCALL=1 INCLUDE ALL ERR LETTERS

 ;BARCALL=2 COUNT O NLY DUE LETTERS

 S BARERRCT=0  ;

 K ^TMP("BARDME",$J) ;p.ott

 D ^BARDMBS     ;CHECK FOR OUTSTANDING BILLS

 S BARCT=0,BARCTQ=0

 F BARCYCLE="CYCLE 1","CYCLE 2","CYCLE 3","CYCLE 4" D A1 D  Q:BARCTQ  ;

A1 ;

 S BARDM=0 F  S BARDM=$O(^BARDM(DUZ(2),"S","Q",BARCYCLE,BARDM)) Q:BARDM'?1N.N  D  Q:BARCTQ

 . Q:$P(^BARDM(DUZ(2),BARDM,0),U,2)'="A"

 . S BARDMC=0

 . F  S BARDMC=$O(^BARDM(DUZ(2),"S","Q",BARCYCLE,BARDM,BARDMC)) Q:BARDMC'?1N.N  D  Q:BARCTQ

 .. ;test for letter already printed

 .. S BARTC="",BARPPF=0

 .. F  S BARTC=$O(^BARDM(DUZ(2),"S","P",BARTC)) Q:$G(BARTC)=""  D

 ... I $D(^BARDM(DUZ(2),"S","P",BARTC,BARDM)) S BARPPF=1

 .. S BARBIEN=$P(^BARDM(DUZ(2),BARDM,0),U)

 ..	I '$D(^BARBL(DUZ(2),BARBIEN,0)) D  Q  ;HEAT118656 BELCOURT P.OTT- BAR*1.8*.24

 ... I $P($G(^VA(200,DUZ,0)),U,4)'="@" Q

 ... W !,"MISSING DATA IN ^BARBL(",DUZ(2),",",BARBIEN

 .. S BARBILN=$$VAL^XBDIQ1(90053.05,BARDM,.01)

 .. I BARPPF=1 S BARBILN=BARBILN_"*"

 .. S BARDAC=$P(^BARBL(DUZ(2),BARBIEN,0),U,3),BARD3P=$P(^(0),U,17)

 .. S BARD3PD=$P(^BARBL(DUZ(2),BARBIEN,0),U,22)

 .. ;

 .. I '$D(^ABMDBILL(BARD3PD,BARD3P)) QUIT  ;DUPLICATE BILL / NONEX CLAIM # P.OTT ADDED FROM BARDMLP

 .. ;

 .. I $P(^BARBL(DUZ(2),BARBIEN,0),U,15)'>0 D  Q  ;P.OTT MAY 2013: ELEVATED THIS LINE (SWAPPED LINES 62 vs 60)

 ... W !,"Bill status of ",$P(^BARBL(DUZ(2),BARBIEN,0),U,1)," changed. Flagging DL as PAID."

 ... D PAID(BARDM,BARDMC) Q

 .. I BARCALL=2 I BARCYCLE'="CYCLE 1" S CY=+$P(BARCYCLE," ",2) D CYDAY^BARDMRU I BARLQ=0 QUIT   ;P.OTT

 .. S BARDI=$$VAL^XBDIQ1(90050.02,BARDAC,.01)

 .. D INSTYP^BARDMU

 .. I '$D(BARDINS(BARDI))&'$D(BARDINS(BARDITY)) Q  ;not insurer type or insurer we are looking for ;P.OTT MAY 2013

 .. D POLCHK

 .. I '$P($G(^BARBL(DUZ(2),BARBIEN,1)),U,2) S ^TMP("BARDME",$J,BARDM,5)=BARHRN_U_BARBILN_U_BARDI_U_"Date of Service",BARERRCT=BARERRCT+1 D ADD2ERR(1)

 .. ;I BARRPT="L" S BARCT=BARCT+1 S:BARCT=BARPMX BARCTQ=1 ;P.OTT REPLACED WITH ADD2ERR

PAID(BARDM,BARDMC) ;SET THE PRINT QUEUED STATUS TO NOT QUEUED AND BILL STATUS TO PAID

 S DIE="^BARDM("_DUZ(2)_","_BARDM_",100,",DA(1)=BARDM,DA=BARDMC

 S DR=".03///N"

 D ^DIE

 K DIE,DA,DR

 S DIE="^BARDM("_DUZ(2)_",",DA=BARDM,DR=".02///P"

 D ^DIE

 K DIE,DA,DR

POLCHK ;TEST FOR POLICY NO, POLICY HOLDER AND POLICY HOLDER DOB

 S BARMIN=0,BARDM("PAT_IEN")="",BARHRN="",BARPAT=""

 I BARDACG'="VA(" D

 .S BARDM("PAT_IEN")=$P(^BARBL(DUZ(2),BARBIEN,1),U)

 .S BARHRN=$P($G(^AUPNPAT(BARDM("PAT_IEN"),41,DUZ(2),0)),U,2)  ; for <UNDEF>POLCHK+4^BARDMRE

 .S BARPAT=$P(^DPT(BARDM("PAT_IEN"),0),U)

 S (BARDM("INS"),BARDM("MEMBER"),BARDM("POL_HOLDER"),BARDM("POL_NUM"),BARDM("POL_DOB"),BARDM("INS_TX"))=""

 I BARDACG="AUTNINS(" D INSCHK

INSCHK ;CHECK INSURANCE

 I $P(^AUTNINS(BARDACI,0),U,11)="" S ^TMP("BARDME",$J,BARDM,6)=BARHRN_U_BARBILN_U_BARDI_U_"Tax ID",BARERRCT=BARERRCT+1 D ADD2ERR(2.1) Q  ;5/17/2013

 I (+$G(^ABMDBILL(BARD3PD,BARD3P,0))=0) S ^TMP("BARDME",$J,BARDM,9)=BARHRN_U_BARBILN_U_BARDI_U_"3P Bill",BARERRCT=BARERRCT+1 D ADD2ERR(2.2) Q  ;

 I $P(^ABMDBILL(BARD3PD,BARD3P,0),U)'=$E(BARBILN,1,$L($P(^ABMDBILL(BARD3PD,BARD3P,0),U))) S ^TMP("BARDME",$J,BARDM,6)=BARHRN_U_BARBILN_U_BARDI_U_"3P Pointer",BARERRCT=BARERRCT+1 D ADD2ERR(2.3) Q  ;

 S BARTST=0  ;

 I $D(^ABMDBILL(BARD3PD,BARD3P,13,"B",BARDACI)) D  ;

 .S BARL="",BARL=$O(^ABMDBILL(BARD3PD,BARD3P,13,"B",BARDACI,BARL))  ;

 .D INSCHK1

 Q:BARTST=1  ;

 S BARL=0 F  S BARL=$O(^ABMDBILL(BARD3PD,BARD3P,13,BARL)) Q:BARL'?1N.N  D  Q:BARTST=1

 .I $P(^ABMDBILL(BARD3PD,BARD3P,13,BARL,0),U,11)=BARDACI D INSCHK1

 I BARTST=0  S ^TMP("BARDME",$J,BARDM,8)=BARHRN_U_BARBILN_U_BARDI_U_"Account/Ins Mismatch",BARERRCT=BARERRCT+1 D ADD2ERR(4)

INSCHK1 ;

 I $P(^ABMDBILL(BARD3PD,BARD3P,13,BARL,0),U,4)'="" D MCR,ERR Q

 I $P(^ABMDBILL(BARD3PD,BARD3P,13,BARL,0),U,5)'="" D RR,ERR Q

 I $P(^ABMDBILL(BARD3PD,BARD3P,13,BARL,0),U,7)'="" D MCD,ERR Q

 I $P(^ABMDBILL(BARD3PD,BARD3P,13,BARL,0),U,8)'="" D PRVT,ERR Q

 ;if it gets to here it means there isn't a pointer back to the specific entry in the appropriate eligible file

 ;lets try to figure it out by insurer type

 I "^R^MD^"[("^"_$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,$P(^ABMDBILL(BARD3PD,BARD3P,13,BARL,0),U),".211","I"),1,"I")_"^")&$$GET1^DIQ(9999999.18,$P(^ABMDBILL(BARD3PD,BARD3P,13,BARL,0),U),".211","E")["MEDICARE" D MCR,ERR Q

 I "^R^MD^"[("^"_$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,$P(^ABMDBILL(BARD3PD,BARD3P,13,BARL,0),U),".211","I"),1,"I")_"^")&$$GET1^DIQ(9999999.18,$P(^ABMDBILL(BARD3PD,BARD3P,13,BARL,0),U),".211","E")["RAILROAD" D RR,ERR Q

 I "^K^"[("^"_$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,$P(^ABMDBILL(BARD3PD,BARD3P,13,BARL,0),U),".211","I"),1,"I")_"^")&($$GET1^DIQ(9999999.18,$P(^ABMDBILL(BARD3PD,BARD3P,13,BARL,0),U),".38","I")["P") D PRVT I BARTST=1 D ERR Q

 I "^D^K^"[("^"_$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,$P(^ABMDBILL(BARD3PD,BARD3P,13,BARL,0),U),".211","I"),1,"I")_"^") D MCD I BARTST=1 D ERR Q

 I "^T^C^FPL^F^I^H^MMC^MC^MH^M^N^SEP^TSI^P^"[("^"_$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,$P(^ABMDBILL(BARD3PD,BARD3P,13,BARL,0),U),".211","I"),1,"I")_"^") D PRVT I BARTST=1 D ERR Q

 I BARTST'=1 S BARTST=1,^TMP("BARDME",$J,BARDM,7)=BARHRN_U_BARBILN_U_BARDI_U_"Bill Insurer Detail",BARERRCT=BARERRCT+1 D ADD2ERR(5)

MCR ;EP

 S BARTST=1  ;

 S BARDM("POL_HOLDER")=$P($G(^AUPNMCR(BARDM("PAT_IEN"),21)),U)

 S BARDM("POL_NUM")="MCR"

 S BARDM("POL_DOB")=$P($G(^AUPNMCR(BARDM("PAT_IEN"),21)),U,2)

 ;BAR V1.8P27 - NMCI CHANGE - IHS/DIT/CPC - 20171027

 ;S BARDM("MEMBER")=$$GETMCR^AGUTL(BARDM("PAT_IEN"))  ;not functional at time of code change

 S BARDM("MEMBER")=$$GETMBI^AUPNMBI(BARDM("PAT_IEN"),DT,0)

 S:+BARDM("MEMBER")=0 BARDM("MEMBER")=$P($G(^AUPNMCR(BARDM("PAT_IEN"),0)),U,3)

MCD ;EP

 S BARTST=1  ;

 S BARDINS=$P(^ABMDBILL(BARD3PD,BARD3P,13,BARL,0),U,6)  ;

 S:$G(BARDINS)="" BARDINS=$P($G(^ABMDBILL(BARD3PD,BARD3P,0)),U,8)  ;

 I BARDINS="" S BARTST=0 Q  ;

 S BARDM("POL_HOLDER")=$P($G(^AUPNMCD(BARDINS,21)),U)

 S BARDM("POL_NUM")="MCD"

 S BARDM("POL_DOB")=$P($G(^AUPNMCD(BARDINS,21)),U,2)

 S BARDM("MEMBER")=$P($G(^AUPNMCD(BARDINS,0)),U,3)

RR ;EP

 S BARTST=1  ;

 S BARDM("POL_HOLDER")=$P($G(^AUPNRRE(BARDM("PAT_IEN"),21)),U)

 S BARDM("POL_NUM")="RR"

 S BARDM("POL_DOB")=$P($G(^AUPNRRE(BARDM("PAT_IEN"),21)),U,2)

  ;BAR V1.8P27 - NMCI CHANGE - IHS/DIT/CPC - 20171027

 ;S BARDM("MEMBER")=$$GETMCR^AGUTL(BARDM("PAT_IEN"))  ;not functional at time of code change

 S BARDM("MEMBER")=$$GETMBI^AUPNMBI(BARDM("PAT_IEN"),DT,0)

 S:+BARDM("MEMBER")=0 BARDM("MEMBER")=$P($G(^AUPNRRE(BARDM("PAT_IEN"),0)),U,4)

PRVT ;EP

 S BARTST=1  ;

 S BARINS=$P(^ABMDBILL(BARD3PD,BARD3P,13,BARL,0),U,8)  ;

 I $G(BARINS)="" S BARINS=$P($G(^ABMDBILL(BARD3PD,BARD3P,0)),U,8),BARINS=$O(^AUPNPRVT(BARDM("PAT_IEN"),11,"B",BARINS,0))  ;

 I BARINS="" S BARTST=0 Q  ;

 S BARDM("POL_HOLDER_IEN")=$P($G(^AUPNPRVT(BARDM("PAT_IEN"),11,BARINS,0)),U,8)

 S BARDM("MEMBER")=$P($G(^AUPNPRVT(BARDM("PAT_IEN"),11,BARINS,2)),U)

 I $G(BARDM("POL_HOLDER_IEN")) D

 .S BARDM("POL_HOLDER")=$P(^AUPN3PPH(BARDM("POL_HOLDER_IEN"),0),U)

 .S BARDM("POL_DOB")=$P(^AUPN3PPH(BARDM("POL_HOLDER_IEN"),0),U,19)

 .S BARDM("POL_NUM")=$P(^AUPN3PPH(BARDM("POL_HOLDER_IEN"),0),U,4)

ERR ;

 S:BARDM("POL_HOLDER")="" ^TMP("BARDME",$J,BARDM,1)=BARHRN_U_BARBILN_U_BARDI_U_"POLICY HOLDER NAME"

 S:BARDM("POL_NUM")="" ^TMP("BARDME",$J,BARDM,2)=BARHRN_U_BARBILN_U_BARDI_U_"POLICY NUMBER"

 S:BARDM("POL_DOB")="" ^TMP("BARDME",$J,BARDM,3)=BARHRN_U_BARBILN_U_BARDI_U_"POLICY HOLDER DOB"

 S:BARDM("MEMBER")="" ^TMP("BARDME",$J,BARDM,4)=BARHRN_U_BARBILN_U_BARDI_U_"MEMBER NUMBER"

 I $D(^TMP("BARDME",$J,BARDM)) S BARERRCT=BARERRCT+1  ;

PRINT ;

 D HDR

 I '$D(^TMP("BARDME",$J)) W !!," There are not any queued Letters with Errors",!! S BMCQ=1 D  Q  ;

 . K DIC,DA,DR,DIR

 . I IOST["C-",'$D(IO("S")) D  ;P.OTT: EXPECT I/O ONLY FROM TERMINAL (AVOID <READ> ERRORS)- BAR*1.8*.23

 . . S DIR(0)="E"

 . . S DIR("A")="Enter RETURN to Continue"

 . . D ^DIR

 S BARL=0,BARCT=0 F  S BARL=$O(^TMP("BARDME",$J,BARL)) Q:BARL'?1N.N  D  Q:$G(BARDLQ)  ;

 . S BARCT=BARCT+1 ;# OF ERR LETTERS

 . I $Y>(IOSL-6) W ! D RTRN^BARDMU Q:$G(BARDLQ)  D HDR

 . S BARL1=0 F  S BARL1=$O(^TMP("BARDME",$J,BARL,BARL1)) Q:BARL1'?1N.N  D  ;

 . . W !,$P(^TMP("BARDME",$J,BARL,BARL1),U),?8,$P(^(BARL1),U,2),?30,$E($P(^(BARL1),U,3),1,29),?60,$P(^(BARL1),U,4)  ;

 W !!

 K DIC,DA,DR,DIR

 I IOST["C-",'$D(IO("S")) D  ;P.OTT: EXPECT I/O ONLY FROM TERMINAL (AVOID <READ> ERRORS)

 . S DIR(0)="E"

 . S DIR("A")="Enter RETURN to Continue"

 . D ^DIR

HDR ;

 S BARPG=BARPG+1  ;

 W @IOF,!,BARRDT,?23,"DEBT MANAGEMENT LETTER ERROR REPORT"

 W:$G(BAROPT)'="B" ?70,"PAGE: ",BARPG  ;

 W !,"A/R PARENT LOCATION: ",BARPNM,!

 F I=1:1:80 W "="

 W !?2,"HRN",?8,"BILL NUMBER",?30,"A/R ACCOUNT",?61,"ERROR"  ;

 W ! F I=1:1:80 W "-"

ADD2ERR(X) ;

 I BARRPT="L" S BARCT=BARCT+1

 Q  ;EOR

BARDMRE   ;IHS/OIT/FCJ - DEBT MANAGEMENT-ERROR REPORT ; 11 Jul 2012  1:34 PM

 +1       ;;1.8;IHS ACCOUNTS RECEIVABLE;**22,23,24,27**;OCT 26, 2005;Build 12

 +2       ;New routine 5-12-2011 for Debt Letter Management

 +3       ;

 +4       ;This report will provide letters ready to be printed by cycle, Insurer and detail

 +5       ;IHS/SD/POT SEP 2012 IGNORE DUPLICATE BILL / NONEX CLAIM # (SAME LOGIC AS IN BARDMLP)

 +6       ;IHS/SD/POT MAY 2013 FIXED COUNT OF 'L'ETTERS (LINE 64)- BAR*1.8*.23

 +7       ;         FIXED <READ> ERRORS: MAKE CALL OF ^DIR CONDITIONAL- BAR*1.8*.23

 +8       ;IHS/SD/POT MAY 2013 CHK / SET STATUS 'PAID'- BAR*1.8*.23

 +9       ;IHS/SD/POT JULY 2013 P.OTT HEAT118656 BELCOURT: SKIP UNDEF ENTRY IN ^BARBL- BAR*1.8*.24

 +10      ;IHS/SD/POT HEAT152452 2/10/2014 CHK IF PAR/SAT FILE CORECTLY SET UP - BAR*1.8*.24

 +11      ;IHS/DIT/CPC New Medicare Card Initiative CR09275 11/3/2017 - BAR*1.8*27

 +12      ;

ST        ;

 +1        SET BMCQ=0

           SET BARRPT="C"

           SET BARSEQ=0

 +2        WRITE !!,"Report for Errors in Letters to be printed"

 +3        DO PAR^BARDMU

 +4       ;P.OTT HEAT152452 2/10/2014- BAR*1.8*.24

           IF $GET(BARQ)

               QUIT

 +5        DO RRDT^BARDMU

 +6        DO ZIS

 +7        QUIT

 +8       ;

ZIS       ;

 +1        DO ZIS^BARDMU

 +2        IF $GET(BARQUIT)

               GOTO XIT

 +3        SET XBRC="CALC^BARDMRE(1)"

           SET XBRX="XIT^BARDMRE"

           SET XBNS="BAR"

 +4        IF $GET(BAROPT)="B"

               SET XBRP="VIEWR^XBLM(""PRINT^BARDMRE"")"

               SET XBIOP=0

 +5       IF '$TEST

               SET XBRP="PRINT^BARDMRE"

 +6        DO ^XBDBQUE

 +7        DO XIT

 +8        QUIT

XIT       ;

 +1        KILL ^TMP("BARDME",$JOB)

 +2        IF $DATA(IO("S"))

               SET IOP="`"_IOS

               DO ^%ZIS

               QUIT

 +3        DO ^%ZISC

 +4       ;

           KILL DIR,BARL,BARL1,BARL2,BARC,BARCT,BARCYCLE,BARTST

 +5        QUIT

 +6       ;

CALC(BARCALL) ;

 +1       ;BARCALL=1 INCLUDE ALL ERR LETTERS

 +2       ;BARCALL=2 COUNT O NLY DUE LETTERS

 +3       ;

           SET BARERRCT=0

 +4       ;p.ott

           KILL ^TMP("BARDME",$JOB)

 +5       ;CHECK FOR OUTSTANDING BILLS

           DO ^BARDMBS

 +6        SET BARCT=0

           SET BARCTQ=0

 +7       ;

           FOR BARCYCLE="CYCLE 1","CYCLE 2","CYCLE 3","CYCLE 4"

               DO A1

               Begin DoDot:1

               End DoDot:1

               IF BARCTQ

                   QUIT

 +8        QUIT

 +9       ;

A1        ;

 +1        SET BARDM=0

FOR

               SET BARDM=$ORDER(^BARDM(DUZ(2),"S","Q",BARCYCLE,BARDM))

               IF BARDM'?1N.N

                   QUIT

               Begin DoDot:1

 +2                IF $PIECE(^BARDM(DUZ(2),BARDM,0),U,2)'="A"

                       QUIT

 +3                SET BARDMC=0

 +4                FOR

                       SET BARDMC=$ORDER(^BARDM(DUZ(2),"S","Q",BARCYCLE,BARDM,BARDMC))

                       IF BARDMC'?1N.N

                           QUIT

                       Begin DoDot:2

 +5       ;test for letter already printed

 +6                        SET BARTC=""

                           SET BARPPF=0

 +7                        FOR

                               SET BARTC=$ORDER(^BARDM(DUZ(2),"S","P",BARTC))

                               IF $GET(BARTC)=""

                                   QUIT

                               Begin DoDot:3

 +8                                IF $DATA(^BARDM(DUZ(2),"S","P",BARTC,BARDM))

                                       SET BARPPF=1

                               End DoDot:3

 +9                        SET BARBIEN=$PIECE(^BARDM(DUZ(2),BARDM,0),U)

 +10      ;HEAT118656 BELCOURT P.OTT- BAR*1.8*.24

BARDMRE.m