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

BARDMRU.m

Go to the documentation of this file. 
  1. BARDMRU ;IHS/OIT/FCJ - DEBT MANAGEMENT-UTILITY FOR REPORTS-CALCULATE BILLS
  1.  ;;1.8;IHS ACCOUNTS RECEIVABLE;**22,23**;OCT 26, 2005;Build 38
  1.  ;New routine 5-12-2011 for Debt Letter Management
  1.  ;
  1.  ;P.OTT SEP  2012 IGNORE DUPLICATE BILL / NONEX CLAIM # (SAME LOGIC AS IN BARDMLP)
  1.  ;P.OTT MAY  2013 ACTIVATE FILTER FOR INSTYPE; CHANGE STATUS TO PAID;
  1.  ;P.OTT JULY 2013 HEAT118656 BELCOURT: SKIP UNDEF ENTRY IN ^BARBL
  1. CALC ;EP;START OF SET OF ARRAY
  1.  ;
  1.  D ^BARDMBS     ;CHECK FOR OUTSTANDING BILLS
  1.  Q:$G(BARQ)
  1.  ;
  1.  I IOST["C-",'$D(IO("S")) W !!,"Running calculations for report."
  1.  S BARCTQ=0,BARCT=0,CY=0
  1.  D BARSETUP ;SETUP ARRAY INS TYPE P.OTT
  1.  F BARL="CYCLE 1","CYCLE 2","CYCLE 3","CYCLE 4" D
  1.  .S ^TMP("BARDM",$J,BARL)="0^0^0"  ;bar*1.8*22 SDR
  1.  .Q:BARCTQ
  1.  .S CY=CY+1
  1.  .D A1
  1.  K BARCTQ
  1.  Q
  1. BARSETUP ;P.OTT MAY 2013
  1.  NEW BARL,BARL1,BARL2,BARPIEN
  1.  S BARPIEN=DUZ(2)
  1.  K BARDINS
  1.  S BARL=0
  1.  F  S BARL=$O(^BAR(90052.06,BARPIEN,DUZ(2),19,BARL)) Q:BARL'?1N.N  D
  1.  .S BARL1=$P(^BAR(90052.06,BARPIEN,DUZ(2),19,BARL,0),U)
  1.  .S BARL2=$$GET1^DIQ(90053.03,BARL1,".01","E")
  1.  .I BARL2'="" S BARDINS(BARL2)=""
  1.  Q
  1.  ;
  1. A1 ; 
  1.  S BARDM=0 F  S BARDM=$O(^BARDM(DUZ(2),"S","Q",BARL,BARDM)) Q:BARDM'?1N.N  D  Q:BARCTQ
  1.  . Q:$P(^BARDM(DUZ(2),BARDM,0),U,2)'="A"  ;bar*1.8*22 SDR
  1.  . S BARDMC=0 F  S BARDMC=$O(^BARDM(DUZ(2),"S","Q",BARL,BARDM,BARDMC)) Q:BARDMC'?1N.N  D  Q:BARCTQ
  1.  .. S BARAMTO=$P(^BARDM(DUZ(2),BARDM,100,BARDMC,0),U,6)
  1.  .. S BARBIEN=$P(^BARDM(DUZ(2),BARDM,0),U)
  1.  .. I '$D(^BARBL(DUZ(2),BARBIEN,0)) D  Q  ;HEAT118656 BELCOURT P.OTT
  1.  ... I $P($G(^VA(200,DUZ,0)),U,4)'="@" Q
  1.  ... W !,"MISSING DATA IN ^BARBL(",DUZ(2),",",BARBIEN
  1.  ... Q
  1.  .. S BARDAC=$P(^BARBL(DUZ(2),BARBIEN,0),U,3),BARAMTB=$P(^(0),U,13),BARDBDT=$P(^(0),U,7)
  1.  .. S BARD3P=$P(^BARBL(DUZ(2),BARBIEN,0),U,17)
  1.  .. S BARD3PD=$P(^BARBL(DUZ(2),BARBIEN,0),U,22)
  1.  .. I '$D(^ABMDBILL(BARD3PD,BARD3P)) QUIT  ;DUPLICATE BILL / NONEX CLAIM # P.OTT ADDED FROM BARDMLP
  1.  .. I $P(^BARBL(DUZ(2),BARBIEN,0),U,15)'>0 D  Q  ;P.OTT MAY 2013
  1.  ... W !,"Bill status of ",$P(^BARBL(DUZ(2),BARBIEN,0),U,1)," changed. Flagging DL as PAID."
  1.  ... D PAID^BARDMRE(BARDM,BARDMC) Q
  1.  .. D INSTYP^BARDMU
  1.  .. S BARDI=$$VAL^XBDIQ1(90050.02,BARDAC,.01)
  1.  .. I '$D(BARDINS(BARDI))&'$D(BARDINS(BARDITY)) Q  ;not insurer type or insurer we are looking for P.OTT MAY 2013
  1.  .. I BARRPT="Q" D RPTQ
  1.  .. ;SET TOTALS BY CYCLE
  1.  .. I BARRPT="C",CY'=1 D CYDAY Q:BARLQ=0
  1.  .. S $P(^TMP("BARDM",$J,BARL),U)=+$P($G(^TMP("BARDM",$J,BARL)),U)+1  ;bar*1.8*22 SDR
  1.  .. S $P(^TMP("BARDM",$J,BARL),U,2)=$P(^TMP("BARDM",$J,BARL),U,2)+BARAMTB
  1.  .. S $P(^TMP("BARDM",$J,BARL),U,3)=$P(^TMP("BARDM",$J,BARL),U,3)+BARAMTO
  1.  .. ;SET TOTALS BY INS TYPE
  1.  .. S:'$G(^TMP("BARDM",$J,BARL,BARDIT)) ^TMP("BARDM",$J,BARL,BARDIT)="0^0^0"
  1.  .. S $P(^TMP("BARDM",$J,BARL,BARDIT),U)=$P(^TMP("BARDM",$J,BARL,BARDIT),U)+1
  1.  .. S $P(^TMP("BARDM",$J,BARL,BARDIT),U,2)=$P(^TMP("BARDM",$J,BARL,BARDIT),U,2)+BARAMTB
  1.  .. S $P(^TMP("BARDM",$J,BARL,BARDIT),U,3)=$P(^TMP("BARDM",$J,BARL,BARDIT),U,3)+BARAMTO
  1.  .. ;SET TOTALS BY INS
  1.  .. S:'$G(^TMP("BARDM",$J,BARL,BARDIT,BARDI)) ^TMP("BARDM",$J,BARL,BARDIT,BARDI)="0^0^0"
  1.  .. S $P(^TMP("BARDM",$J,BARL,BARDIT,BARDI),U)=$P(^TMP("BARDM",$J,BARL,BARDIT,BARDI),U)+1
  1.  .. S $P(^TMP("BARDM",$J,BARL,BARDIT,BARDI),U,2)=$P(^TMP("BARDM",$J,BARL,BARDIT,BARDI),U,2)+BARAMTB
  1.  .. S $P(^TMP("BARDM",$J,BARL,BARDIT,BARDI),U,3)=$P(^TMP("BARDM",$J,BARL,BARDIT,BARDI),U,3)+BARAMTO
  1.  .. S BARCT=BARCT+1 I BARCT=BARPMX,BARRPT="C" S BARCTQ=1
  1.  .. S ^TMP("BARDM",$J,"DMIR-DET",BARL,BARDIT,BARDI,BARDM)=""
  1.  Q
  1. RPTQ ;SET OTHER ITEMS FOR THE QUEUED LET REPORT
  1.  S ^TMP("BARDM",$J,BARL,BARDIT,BARDI,$E($P(^BARBL(DUZ(2),BARBIEN,0),U),1,8))=$P(^BARBL(DUZ(2),BARBIEN,1),U)_U_$P(^(1),U,2)_U_BARDBDT_U_BARAMTB_U_BARAMTO
  1.  Q
  1.  ;
  1. CYDAY ;EP;CYCLE DAY TEST
  1.  S BARLQ=0
  1.  S BARR=0
  1.  S BARR=$O(^BARDM(DUZ(2),BARDM,100,"B","CYCLE "_(CY-1),BARR))
  1.  S X2=$P(^BARDM(DUZ(2),BARDM,100,BARR,0),U,5)
  1.  S X1=DT
  1.  D ^%DTC
  1.  ;COMPARE ABOVE DAYS (last print date-DT) WITH CYCLE DAYS TO PRINT NXT LETTER...
  1.  I (X+1)>(BARPCD(CY)-BARPCD(CY-1)) S BARLQ=1
  1.  Q  ;EOR