Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BARDMRE

BARDMRE.m

Go to the documentation of this file. 
  1. 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
  1.  ;New routine 5-12-2011 for Debt Letter Management
  1.  ;
  1.  ;This report will provide letters ready to be printed by cycle, Insurer and detail
  1.  ;IHS/SD/POT SEP 2012 IGNORE DUPLICATE BILL / NONEX CLAIM # (SAME LOGIC AS IN BARDMLP)
  1.  ;IHS/SD/POT MAY 2013 FIXED COUNT OF 'L'ETTERS (LINE 64)- BAR*1.8*.23
  1.  ;         FIXED <READ> ERRORS: MAKE CALL OF ^DIR CONDITIONAL- BAR*1.8*.23
  1.  ;IHS/SD/POT MAY 2013 CHK / SET STATUS 'PAID'- BAR*1.8*.23
  1.  ;IHS/SD/POT JULY 2013 P.OTT HEAT118656 BELCOURT: SKIP UNDEF ENTRY IN ^BARBL- BAR*1.8*.24
  1.  ;IHS/SD/POT HEAT152452 2/10/2014 CHK IF PAR/SAT FILE CORECTLY SET UP - BAR*1.8*.24
  1.  ;IHS/DIT/CPC New Medicare Card Initiative CR09275 11/3/2017 - BAR*1.8*27
  1.  ;
  1. ST ;
  1.  S BMCQ=0,BARRPT="C",BARSEQ=0
  1.  W !!,"Report for Errors in Letters to be printed"
  1.  D PAR^BARDMU
  1.  Q:$G(BARQ)  ;P.OTT HEAT152452 2/10/2014- BAR*1.8*.24
  1.  D RRDT^BARDMU
  1.  D ZIS
  1.  Q
  1.  ;
  1. ZIS ;
  1.  D ZIS^BARDMU
  1.  G:$G(BARQUIT) XIT
  1.  S XBRC="CALC^BARDMRE(1)",XBRX="XIT^BARDMRE",XBNS="BAR"
  1.  I $G(BAROPT)="B" S XBRP="VIEWR^XBLM(""PRINT^BARDMRE"")",XBIOP=0
  1.  E  S XBRP="PRINT^BARDMRE"
  1.  D ^XBDBQUE
  1.  D XIT
  1.  Q
  1. XIT ;
  1.  K ^TMP("BARDME",$J)
  1.  I $D(IO("S")) S IOP="`"_IOS D ^%ZIS Q
  1.  D ^%ZISC
  1.  K DIR,BARL,BARL1,BARL2,BARC,BARCT,BARCYCLE,BARTST  ;
  1.  Q
  1.  ;
  1. CALC(BARCALL) ;
  1.  ;BARCALL=1 INCLUDE ALL ERR LETTERS
  1.  ;BARCALL=2 COUNT O NLY DUE LETTERS
  1.  S BARERRCT=0  ;
  1.  K ^TMP("BARDME",$J) ;p.ott
  1.  D ^BARDMBS     ;CHECK FOR OUTSTANDING BILLS
  1.  S BARCT=0,BARCTQ=0
  1.  F BARCYCLE="CYCLE 1","CYCLE 2","CYCLE 3","CYCLE 4" D A1 D  Q:BARCTQ  ;
  1.  Q
  1.  ;
  1. A1 ;
  1.  S BARDM=0 F  S BARDM=$O(^BARDM(DUZ(2),"S","Q",BARCYCLE,BARDM)) Q:BARDM'?1N.N  D  Q:BARCTQ
  1.  . Q:$P(^BARDM(DUZ(2),BARDM,0),U,2)'="A"
  1.  . S BARDMC=0
  1.  . F  S BARDMC=$O(^BARDM(DUZ(2),"S","Q",BARCYCLE,BARDM,BARDMC)) Q:BARDMC'?1N.N  D  Q:BARCTQ
  1.  .. ;test for letter already printed
  1.  .. S BARTC="",BARPPF=0
  1.  .. F  S BARTC=$O(^BARDM(DUZ(2),"S","P",BARTC)) Q:$G(BARTC)=""  D
  1.  ... I $D(^BARDM(DUZ(2),"S","P",BARTC,BARDM)) S BARPPF=1
  1.  .. S BARBIEN=$P(^BARDM(DUZ(2),BARDM,0),U)
  1.  ..	I '$D(^BARBL(DUZ(2),BARBIEN,0)) D  Q  ;HEAT118656 BELCOURT P.OTT- BAR*1.8*.24
  1.  ... I $P($G(^VA(200,DUZ,0)),U,4)'="@" Q
  1.  ... W !,"MISSING DATA IN ^BARBL(",DUZ(2),",",BARBIEN
  1.  .. S BARBILN=$$VAL^XBDIQ1(90053.05,BARDM,.01)
  1.  .. I BARPPF=1 S BARBILN=BARBILN_"*"
  1.  .. S BARDAC=$P(^BARBL(DUZ(2),BARBIEN,0),U,3),BARD3P=$P(^(0),U,17)
  1.  .. S BARD3PD=$P(^BARBL(DUZ(2),BARBIEN,0),U,22)
  1.  .. ;
  1.  .. I '$D(^ABMDBILL(BARD3PD,BARD3P)) QUIT  ;DUPLICATE BILL / NONEX CLAIM # P.OTT ADDED FROM BARDMLP
  1.  .. ;
  1.  .. I $P(^BARBL(DUZ(2),BARBIEN,0),U,15)'>0 D  Q  ;P.OTT MAY 2013: ELEVATED THIS LINE (SWAPPED LINES 62 vs 60)
  1.  ... W !,"Bill status of ",$P(^BARBL(DUZ(2),BARBIEN,0),U,1)," changed. Flagging DL as PAID."
  1.  ... D PAID(BARDM,BARDMC) Q
  1.  .. I BARCALL=2 I BARCYCLE'="CYCLE 1" S CY=+$P(BARCYCLE," ",2) D CYDAY^BARDMRU I BARLQ=0 QUIT   ;P.OTT
  1.  .. S BARDI=$$VAL^XBDIQ1(90050.02,BARDAC,.01)
  1.  .. D INSTYP^BARDMU
  1.  .. I '$D(BARDINS(BARDI))&'$D(BARDINS(BARDITY)) Q  ;not insurer type or insurer we are looking for ;P.OTT MAY 2013
  1.  .. D POLCHK
  1.  .. 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)
  1.  .. ;I BARRPT="L" S BARCT=BARCT+1 S:BARCT=BARPMX BARCTQ=1 ;P.OTT REPLACED WITH ADD2ERR
  1.  Q
  1.  S DIE="^BARDM("_DUZ(2)_","_BARDM_",100,",DA(1)=BARDM,DA=BARDMC
  1.  S DR=".03///N"
  1.  D ^DIE
  1.  K DIE,DA,DR
  1.  S DIE="^BARDM("_DUZ(2)_",",DA=BARDM,DR=".02///P"
  1.  D ^DIE
  1.  K DIE,DA,DR
  1.  Q
  1.  ;
  1. POLCHK ;TEST FOR POLICY NO, POLICY HOLDER AND POLICY HOLDER DOB
  1.  S BARMIN=0,BARDM("PAT_IEN")="",BARHRN="",BARPAT=""
  1.  I BARDACG'="VA(" D
  1.  .S BARDM("PAT_IEN")=$P(^BARBL(DUZ(2),BARBIEN,1),U)
  1.  .S BARHRN=$P($G(^AUPNPAT(BARDM("PAT_IEN"),41,DUZ(2),0)),U,2)  ; for <UNDEF>POLCHK+4^BARDMRE
  1.  .S BARPAT=$P(^DPT(BARDM("PAT_IEN"),0),U)
  1.  S (BARDM("INS"),BARDM("MEMBER"),BARDM("POL_HOLDER"),BARDM("POL_NUM"),BARDM("POL_DOB"),BARDM("INS_TX"))=""
  1.  I BARDACG="AUTNINS(" D INSCHK
  1.  Q
  1. INSCHK ;CHECK INSURANCE 
  1.  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
  1.  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  ;
  1.  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  ;
  1.  S BARTST=0  ;
  1.  I $D(^ABMDBILL(BARD3PD,BARD3P,13,"B",BARDACI)) D  ;
  1.  .S BARL="",BARL=$O(^ABMDBILL(BARD3PD,BARD3P,13,"B",BARDACI,BARL))  ;
  1.  .D INSCHK1
  1.  Q:BARTST=1  ;
  1.  S BARL=0 F  S BARL=$O(^ABMDBILL(BARD3PD,BARD3P,13,BARL)) Q:BARL'?1N.N  D  Q:BARTST=1
  1.  .I $P(^ABMDBILL(BARD3PD,BARD3P,13,BARL,0),U,11)=BARDACI D INSCHK1
  1.  I BARTST=0  S ^TMP("BARDME",$J,BARDM,8)=BARHRN_U_BARBILN_U_BARDI_U_"Account/Ins Mismatch",BARERRCT=BARERRCT+1 D ADD2ERR(4)
  1.  Q
  1. INSCHK1 ;
  1.  I $P(^ABMDBILL(BARD3PD,BARD3P,13,BARL,0),U,4)'="" D MCR,ERR Q
  1.  I $P(^ABMDBILL(BARD3PD,BARD3P,13,BARL,0),U,5)'="" D RR,ERR Q
  1.  I $P(^ABMDBILL(BARD3PD,BARD3P,13,BARL,0),U,7)'="" D MCD,ERR Q
  1.  I $P(^ABMDBILL(BARD3PD,BARD3P,13,BARL,0),U,8)'="" D PRVT,ERR Q
  1.  ;if it gets to here it means there isn't a pointer back to the specific entry in the appropriate eligible file
  1.  ;lets try to figure it out by insurer type
  1.  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
  1.  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
  1.  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
  1.  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
  1.  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
  1.  ;
  1.  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)
  1.  Q
  1. MCR ;EP
  1.  S BARTST=1  ;
  1.  S BARDM("POL_HOLDER")=$P($G(^AUPNMCR(BARDM("PAT_IEN"),21)),U)
  1.  S BARDM("POL_NUM")="MCR"
  1.  S BARDM("POL_DOB")=$P($G(^AUPNMCR(BARDM("PAT_IEN"),21)),U,2)
  1.  ;BAR V1.8P27 - NMCI CHANGE - IHS/DIT/CPC - 20171027
  1.  ;S BARDM("MEMBER")=$$GETMCR^AGUTL(BARDM("PAT_IEN"))  ;not functional at time of code change
  1.  S BARDM("MEMBER")=$$GETMBI^AUPNMBI(BARDM("PAT_IEN"),DT,0)
  1.  S:+BARDM("MEMBER")=0 BARDM("MEMBER")=$P($G(^AUPNMCR(BARDM("PAT_IEN"),0)),U,3)
  1.  Q
  1. MCD ;EP
  1.  S BARTST=1  ;
  1.  S BARDINS=$P(^ABMDBILL(BARD3PD,BARD3P,13,BARL,0),U,6)  ;
  1.  S:$G(BARDINS)="" BARDINS=$P($G(^ABMDBILL(BARD3PD,BARD3P,0)),U,8)  ;
  1.  I BARDINS="" S BARTST=0 Q  ;
  1.  S BARDM("POL_HOLDER")=$P($G(^AUPNMCD(BARDINS,21)),U)
  1.  S BARDM("POL_NUM")="MCD"
  1.  S BARDM("POL_DOB")=$P($G(^AUPNMCD(BARDINS,21)),U,2)
  1.  S BARDM("MEMBER")=$P($G(^AUPNMCD(BARDINS,0)),U,3)
  1.  Q
  1. RR ;EP
  1.  S BARTST=1  ;
  1.  S BARDM("POL_HOLDER")=$P($G(^AUPNRRE(BARDM("PAT_IEN"),21)),U)
  1.  S BARDM("POL_NUM")="RR"
  1.  S BARDM("POL_DOB")=$P($G(^AUPNRRE(BARDM("PAT_IEN"),21)),U,2)
  1.   ;BAR V1.8P27 - NMCI CHANGE - IHS/DIT/CPC - 20171027
  1.  ;S BARDM("MEMBER")=$$GETMCR^AGUTL(BARDM("PAT_IEN"))  ;not functional at time of code change
  1.  S BARDM("MEMBER")=$$GETMBI^AUPNMBI(BARDM("PAT_IEN"),DT,0)
  1.  S:+BARDM("MEMBER")=0 BARDM("MEMBER")=$P($G(^AUPNRRE(BARDM("PAT_IEN"),0)),U,4)
  1.  Q
  1. PRVT ;EP
  1.  S BARTST=1  ;
  1.  S BARINS=$P(^ABMDBILL(BARD3PD,BARD3P,13,BARL,0),U,8)  ;
  1.  I $G(BARINS)="" S BARINS=$P($G(^ABMDBILL(BARD3PD,BARD3P,0)),U,8),BARINS=$O(^AUPNPRVT(BARDM("PAT_IEN"),11,"B",BARINS,0))  ;
  1.  I BARINS="" S BARTST=0 Q  ;
  1.  S BARDM("POL_HOLDER_IEN")=$P($G(^AUPNPRVT(BARDM("PAT_IEN"),11,BARINS,0)),U,8)
  1.  S BARDM("MEMBER")=$P($G(^AUPNPRVT(BARDM("PAT_IEN"),11,BARINS,2)),U)
  1.  I $G(BARDM("POL_HOLDER_IEN")) D
  1.  .S BARDM("POL_HOLDER")=$P(^AUPN3PPH(BARDM("POL_HOLDER_IEN"),0),U)
  1.  .S BARDM("POL_DOB")=$P(^AUPN3PPH(BARDM("POL_HOLDER_IEN"),0),U,19)
  1.  .S BARDM("POL_NUM")=$P(^AUPN3PPH(BARDM("POL_HOLDER_IEN"),0),U,4)
  1.  Q
  1.  ;
  1. ERR ;
  1.  S:BARDM("POL_HOLDER")="" ^TMP("BARDME",$J,BARDM,1)=BARHRN_U_BARBILN_U_BARDI_U_"POLICY HOLDER NAME"
  1.  S:BARDM("POL_NUM")="" ^TMP("BARDME",$J,BARDM,2)=BARHRN_U_BARBILN_U_BARDI_U_"POLICY NUMBER"
  1.  S:BARDM("POL_DOB")="" ^TMP("BARDME",$J,BARDM,3)=BARHRN_U_BARBILN_U_BARDI_U_"POLICY HOLDER DOB"
  1.  S:BARDM("MEMBER")="" ^TMP("BARDME",$J,BARDM,4)=BARHRN_U_BARBILN_U_BARDI_U_"MEMBER NUMBER"
  1.  I $D(^TMP("BARDME",$J,BARDM)) S BARERRCT=BARERRCT+1  ;
  1.  Q
  1.  ;
  1. PRINT ;
  1.  D HDR
  1.  I '$D(^TMP("BARDME",$J)) W !!," There are not any queued Letters with Errors",!! S BMCQ=1 D  Q  ;
  1.  . K DIC,DA,DR,DIR
  1.  . I IOST["C-",'$D(IO("S")) D  ;P.OTT: EXPECT I/O ONLY FROM TERMINAL (AVOID <READ> ERRORS)- BAR*1.8*.23
  1.  . . S DIR(0)="E"
  1.  . . S DIR("A")="Enter RETURN to Continue"
  1.  . . D ^DIR
  1.  S BARL=0,BARCT=0 F  S BARL=$O(^TMP("BARDME",$J,BARL)) Q:BARL'?1N.N  D  Q:$G(BARDLQ)  ;
  1.  . S BARCT=BARCT+1 ;# OF ERR LETTERS
  1.  . I $Y>(IOSL-6) W ! D RTRN^BARDMU Q:$G(BARDLQ)  D HDR
  1.  . S BARL1=0 F  S BARL1=$O(^TMP("BARDME",$J,BARL,BARL1)) Q:BARL1'?1N.N  D  ;
  1.  . . 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)  ;
  1.  W !!
  1.  K DIC,DA,DR,DIR
  1.  I IOST["C-",'$D(IO("S")) D  ;P.OTT: EXPECT I/O ONLY FROM TERMINAL (AVOID <READ> ERRORS)
  1.  . S DIR(0)="E"
  1.  . S DIR("A")="Enter RETURN to Continue"
  1.  . D ^DIR
  1.  Q
  1.  ;
  1. HDR ;
  1.  S BARPG=BARPG+1  ;
  1.  W @IOF,!,BARRDT,?23,"DEBT MANAGEMENT LETTER ERROR REPORT"
  1.  W:$G(BAROPT)'="B" ?70,"PAGE: ",BARPG  ;
  1.  W !,"A/R PARENT LOCATION: ",BARPNM,!
  1.  F I=1:1:80 W "="
  1.  W !?2,"HRN",?8,"BILL NUMBER",?30,"A/R ACCOUNT",?61,"ERROR"  ;
  1.  W ! F I=1:1:80 W "-"
  1.  Q
  1. ADD2ERR(X) ;
  1.  I BARRPT="L" S BARCT=BARCT+1
  1.  Q  ;EOR