BARDMRQC ;IHS/OIT/FCJ - DEBT MANAGEMENT-PRINTED LETTER REPORT
;;1.8;IHS ACCOUNTS RECEIVABLE;**22,23**;OCT 26, 2005;Build 38
;New routine AUG 2012 for Debt Letter Management
;
;This report shows recently printed letters by cycle, Insurer and detail
;
;code cloned from BARDMRU ;P.OTT
;P.OTT MAY 2013 ACTIVATE FILTER FOR INSTYPE; IGNORE BILLS WITH ZERO BALANCE
;P.OTT OCT 2013 ADDED FILTER TO DISPLAY 'ORIGINAL' or 'CURRENT' list of printed letters
Q
CALC I IOST["C-",'$D(IO("S")) W !!,"Running calculations for report of printed letters."
S BARCTQ=0,BARCT=0,CY=0
K ^TMP("BARDM",$J,"QN")
S ^TMP("BARDM",$J,"QN")=0 ;FOR BARSEQ
D BARSETUP ;P.OTT
F BARL="CYCLE 1","CYCLE 2","CYCLE 3","CYCLE 4" D
. S ^TMP("BARDM",$J,"QN",BARL)="0^0^0" ;bar*1.8*22 SDR
. Q:BARCTQ
. S CY=CY+1
. D A1(BARL)
S BARCNT=0,BARL="" F S BARL=$O(^TMP("BARDM",$J,"QN",BARL)) Q:BARL="" S BARCNT=BARCNT+$G(^TMP("BARDM",$J,"QN",BARL)) ;P.OTT 4/11
S ^TMP("BARDM",$J,"QN")=BARCNT
K BARCTQ,BARCNT
Q
BARSETUP ;P.OTT MAY 2013
NEW BARL,BARL1,BARL2,BARPIEN
S BARPIEN=DUZ(2)
K BARDINS
S BARL=0
F S BARL=$O(^BAR(90052.06,BARPIEN,DUZ(2),19,BARL)) Q:BARL'?1N.N D
. S BARL1=$P(^BAR(90052.06,BARPIEN,DUZ(2),19,BARL,0),U)
. S BARL2=$$GET1^DIQ(90053.03,BARL1,".01","E")
. I BARL2'="" S BARDINS(BARL2)=""
Q
;
A1(BARL) ;
;^TMP("BARDMQN",$J,BARL,BARDM,BARDMC)=BARDMINS
NEW BARDM,BARDMC,BARAMTB,BARAMTO,BARBIEN,BARDAC,BARDBDT,BARDI,BARDIT,BARDM,BARDMC
S BARDM=0 F S BARDM=$O(^TMP("BARDMQN",$J,BARL,BARDM)) Q:BARDM'?1N.N D Q:BARCTQ
. ;will list all printed dl (even if status changed to P or S)
. ;;;Q:$P(^BARDM(DUZ(2),BARDM,0),U,2)'="A" ;bar*1.8*22 SDR
. S BARDMC=0 F S BARDMC=$O(^TMP("BARDMQN",$J,BARL,BARDM,BARDMC)) Q:BARDMC'?1N.N D Q:BARCTQ
.. S BARAMTO=$P(^BARDM(DUZ(2),BARDM,100,BARDMC,0),U,6)
.. S BARBIEN=$P(^BARDM(DUZ(2),BARDM,0),U)
.. ;----next line will be parameter driven
.. ;for now will list all printed dl (even if the bill was meanwhile zeroed
.. ;------
.. S BARMOD2=$G(BARMOD2)
.. I DUZ=902 S BAROK=0 D I 'BAROK Q
... I BARMOD2=""!(BARMOD2="O") S BAROK=1 Q ;SHOW ALWAYS
... I BARMOD2="Z" I $P(^BARBL(DUZ(2),BARBIEN,0),U,15)=0 S BAROK=1 Q ;SHOW ZERO BALANCE
... I BARMOD2="C" I $P(^BARBL(DUZ(2),BARBIEN,0),U,15)'>0 S BAROK=1 Q ;SHOW NON-ZERO BALANCE
.. S BARDAC=$P(^BARBL(DUZ(2),BARBIEN,0),U,3),BARAMTB=$P(^(0),U,13),BARDBDT=$P(^(0),U,7)
.. D INSTYP^BARDMU
.. S BARDI=$$VAL^XBDIQ1(90050.02,BARDAC,.01)
.. ;will list all printed dl (filtering letters by insurer was before printing! - do not do it here)
.. ;;;I '$D(BARDINS(BARDI))&'$D(BARDINS(BARDITY)) Q ;not ins we are looking for
.. D RPTQ
.. ;SET TOTALS BY CYCLE
.. S $P(^TMP("BARDM",$J,"QN",BARL),U)=+$P($G(^TMP("BARDM",$J,"QN",BARL)),U)+1 ;bar*1.8*22 SDR
.. S $P(^TMP("BARDM",$J,"QN",BARL),U,2)=$P(^TMP("BARDM",$J,"QN",BARL),U,2)+BARAMTB
.. S $P(^TMP("BARDM",$J,"QN",BARL),U,3)=$P(^TMP("BARDM",$J,"QN",BARL),U,3)+BARAMTO
.. S:'$G(^TMP("BARDM",$J,"QN",BARL,BARDIT)) ^TMP("BARDM",$J,"QN",BARL,BARDIT)="0^0^0"
.. S $P(^TMP("BARDM",$J,"QN",BARL,BARDIT),U)=$P(^TMP("BARDM",$J,"QN",BARL,BARDIT),U)+1
.. S $P(^TMP("BARDM",$J,"QN",BARL,BARDIT),U,2)=$P(^TMP("BARDM",$J,"QN",BARL,BARDIT),U,2)+BARAMTB
.. S $P(^TMP("BARDM",$J,"QN",BARL,BARDIT),U,3)=$P(^TMP("BARDM",$J,"QN",BARL,BARDIT),U,3)+BARAMTO
.. ;SET TOTALS BY INS
.. S:'$G(^TMP("BARDM",$J,"QN",BARL,BARDIT,BARDI)) ^TMP("BARDM",$J,"QN",BARL,BARDIT,BARDI)="0^0^0"
.. S $P(^TMP("BARDM",$J,"QN",BARL,BARDIT,BARDI),U)=$P(^TMP("BARDM",$J,"QN",BARL,BARDIT,BARDI),U)+1
.. S $P(^TMP("BARDM",$J,"QN",BARL,BARDIT,BARDI),U,2)=$P(^TMP("BARDM",$J,"QN",BARL,BARDIT,BARDI),U,2)+BARAMTB
.. S $P(^TMP("BARDM",$J,"QN",BARL,BARDIT,BARDI),U,3)=$P(^TMP("BARDM",$J,"QN",BARL,BARDIT,BARDI),U,3)+BARAMTO
Q
RPTQ ;SET OTHER ITEMS FOR THE QUEUED LET REPORT
S ^TMP("BARDM",$J,"QN",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
Q ;EOR
BARDMRQC ;IHS/OIT/FCJ - DEBT MANAGEMENT-PRINTED LETTER REPORT
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**22,23**;OCT 26, 2005;Build 38
+2 ;New routine AUG 2012 for Debt Letter Management
+3 ;
+4 ;This report shows recently printed letters by cycle, Insurer and detail
+5 ;
+6 ;code cloned from BARDMRU ;P.OTT
+7 ;P.OTT MAY 2013 ACTIVATE FILTER FOR INSTYPE; IGNORE BILLS WITH ZERO BALANCE
+8 ;P.OTT OCT 2013 ADDED FILTER TO DISPLAY 'ORIGINAL' or 'CURRENT' list of printed letters
+9 QUIT
CALC IF IOST["C-"
IF '$DATA(IO("S"))
WRITE !!,"Running calculations for report of printed letters."
+1 SET BARCTQ=0
SET BARCT=0
SET CY=0
+2 KILL ^TMP("BARDM",$JOB,"QN")
+3 ;FOR BARSEQ
SET ^TMP("BARDM",$JOB,"QN")=0
+4 ;P.OTT
DO BARSETUP
+5 FOR BARL="CYCLE 1","CYCLE 2","CYCLE 3","CYCLE 4"
Begin DoDot:1
+6 ;bar*1.8*22 SDR
SET ^TMP("BARDM",$JOB,"QN",BARL)="0^0^0"
+7 IF BARCTQ
QUIT
+8 SET CY=CY+1
+9 DO A1(BARL)
End DoDot:1
+10 ;P.OTT 4/11
SET BARCNT=0
SET BARL=""
FOR
SET BARL=$ORDER(^TMP("BARDM",$JOB,"QN",BARL))
IF BARL=""
QUIT
SET BARCNT=BARCNT+$GET(^TMP("BARDM",$JOB,"QN",BARL))
+11 SET ^TMP("BARDM",$JOB,"QN")=BARCNT
+12 KILL BARCTQ,BARCNT
+13 QUIT
BARSETUP ;P.OTT MAY 2013
+1 NEW BARL,BARL1,BARL2,BARPIEN
+2 SET BARPIEN=DUZ(2)
+3 KILL BARDINS
+4 SET BARL=0
+5 FOR
SET BARL=$ORDER(^BAR(90052.06,BARPIEN,DUZ(2),19,BARL))
IF BARL'?1N.N
QUIT
Begin DoDot:1
+6 SET BARL1=$PIECE(^BAR(90052.06,BARPIEN,DUZ(2),19,BARL,0),U)
+7 SET BARL2=$$GET1^DIQ(90053.03,BARL1,".01","E")
+8 IF BARL2'=""
SET BARDINS(BARL2)=""
End DoDot:1
+9 QUIT
+10 ;
A1(BARL) ;
+1 ;^TMP("BARDMQN",$J,BARL,BARDM,BARDMC)=BARDMINS
+2 NEW BARDM,BARDMC,BARAMTB,BARAMTO,BARBIEN,BARDAC,BARDBDT,BARDI,BARDIT,BARDM,BARDMC
+3 SET BARDM=0
FOR
SET BARDM=$ORDER(^TMP("BARDMQN",$JOB,BARL,BARDM))
IF BARDM'?1N.N
QUIT
Begin DoDot:1
+4 ;will list all printed dl (even if status changed to P or S)
+5 ;;;Q:$P(^BARDM(DUZ(2),BARDM,0),U,2)'="A" ;bar*1.8*22 SDR
+6 SET BARDMC=0
FOR
SET BARDMC=$ORDER(^TMP("BARDMQN",$JOB,BARL,BARDM,BARDMC))
IF BARDMC'?1N.N
QUIT
Begin DoDot:2
+7 SET BARAMTO=$PIECE(^BARDM(DUZ(2),BARDM,100,BARDMC,0),U,6)
+8 SET BARBIEN=$PIECE(^BARDM(DUZ(2),BARDM,0),U)
+9 ;----next line will be parameter driven
+10 ;for now will list all printed dl (even if the bill was meanwhile zeroed
+11 ;------
+12 SET BARMOD2=$GET(BARMOD2)
+13 IF DUZ=902
SET BAROK=0
Begin DoDot:3
+14 ;SHOW ALWAYS
IF BARMOD2=""!(BARMOD2="O")
SET BAROK=1
QUIT
+15 ;SHOW ZERO BALANCE
IF BARMOD2="Z"
IF $PIECE(^BARBL(DUZ(2),BARBIEN,0),U,15)=0
SET BAROK=1
QUIT
+16 ;SHOW NON-ZERO BALANCE
IF BARMOD2="C"
IF $PIECE(^BARBL(DUZ(2),BARBIEN,0),U,15)'>0
SET BAROK=1
QUIT
End DoDot:3
IF 'BAROK
QUIT
+17 SET BARDAC=$PIECE(^BARBL(DUZ(2),BARBIEN,0),U,3)
SET BARAMTB=$PIECE(^(0),U,13)
SET BARDBDT=$PIECE(^(0),U,7)
+18 DO INSTYP^BARDMU
+19 SET BARDI=$$VAL^XBDIQ1(90050.02,BARDAC,.01)
+20 ;will list all printed dl (filtering letters by insurer was before printing! - do not do it here)
+21 ;;;I '$D(BARDINS(BARDI))&'$D(BARDINS(BARDITY)) Q ;not ins we are looking for
+22 DO RPTQ
+23 ;SET TOTALS BY CYCLE
+24 ;bar*1.8*22 SDR
SET $PIECE(^TMP("BARDM",$JOB,"QN",BARL),U)=+$PIECE($GET(^TMP("BARDM",$JOB,"QN",BARL)),U)+1
+25 SET $PIECE(^TMP("BARDM",$JOB,"QN",BARL),U,2)=$PIECE(^TMP("BARDM",$JOB,"QN",BARL),U,2)+BARAMTB
+26 SET $PIECE(^TMP("BARDM",$JOB,"QN",BARL),U,3)=$PIECE(^TMP("BARDM",$JOB,"QN",BARL),U,3)+BARAMTO
+27 IF '$GET(^TMP("BARDM",$JOB,"QN",BARL,BARDIT))
SET ^TMP("BARDM",$JOB,"QN",BARL,BARDIT)="0^0^0"
+28 SET $PIECE(^TMP("BARDM",$JOB,"QN",BARL,BARDIT),U)=$PIECE(^TMP("BARDM",$JOB,"QN",BARL,BARDIT),U)+1
+29 SET $PIECE(^TMP("BARDM",$JOB,"QN",BARL,BARDIT),U,2)=$PIECE(^TMP("BARDM",$JOB,"QN",BARL,BARDIT),U,2)+BARAMTB
+30 SET $PIECE(^TMP("BARDM",$JOB,"QN",BARL,BARDIT),U,3)=$PIECE(^TMP("BARDM",$JOB,"QN",BARL,BARDIT),U,3)+BARAMTO
+31 ;SET TOTALS BY INS
+32 IF '$GET(^TMP("BARDM",$JOB,"QN",BARL,BARDIT,BARDI))
SET ^TMP("BARDM",$JOB,"QN",BARL,BARDIT,BARDI)="0^0^0"
+33 SET $PIECE(^TMP("BARDM",$JOB,"QN",BARL,BARDIT,BARDI),U)=$PIECE(^TMP("BARDM",$JOB,"QN",BARL,BARDIT,BARDI),U)+1
+34 SET $PIECE(^TMP("BARDM",$JOB,"QN",BARL,BARDIT,BARDI),U,2)=$PIECE(^TMP("BARDM",$JOB,"QN",BARL,BARDIT,BARDI),U,2)+BARAMTB
+35 SET $PIECE(^TMP("BARDM",$JOB,"QN",BARL,BARDIT,BARDI),U,3)=$PIECE(^TMP("BARDM",$JOB,"QN",BARL,BARDIT,BARDI),U,3)+BARAMTO
End DoDot:2
IF BARCTQ
QUIT
End DoDot:1
IF BARCTQ
QUIT
+36 QUIT
RPTQ ;SET OTHER ITEMS FOR THE QUEUED LET REPORT
+1 SET ^TMP("BARDM",$JOB,"QN",BARL,BARDIT,BARDI,$EXTRACT($PIECE(^BARBL(DUZ(2),BARBIEN,0),U),1,8))=$PIECE(^BARBL(DUZ(2),BARBIEN,1),U)_U_$PIECE(^(1),U,2)_U_BARDBDT_U_BARAMTB_U_BARAMTO
+2 ;EOR
QUIT
