BARDMR1 ;IHS/OIT/FCJ - DEBT MANAGEMENT-LETTERS READY TO PRINT REPORT
;;1.8;IHS ACCOUNTS RECEIVABLE;**22,24**;OCT 26, 2005;Build 69
;New routine 5-12-2011 for Debt Letter Management
;
;This report will provide letters ready to be printed by cycle
;
;IHS/SD/POT HEAT152452 2/10/2014 BAR*1.8*.24
ST ;
;
W !!,"Report for Insurer Letter's to be printed"
S BARRPT="C"
D PAR^BARDMU
Q:$G(BARQ) ;P.OTT HEAT152452 2/10/2014 - BAR*1.8*.24
D RRDT^BARDMU
D ZIS
Q
;
ZIS ;
D ZIS^BARDMU
G:$G(BARQUIT) XIT
S XBRC="CALC^BARDMRU",XBRX="XIT^BARDMR1",XBNS="BAR"
I $G(BAROPT)="B" S XBRP="VIEWR^XBLM(""PRINT^BARDMR1"")",XBIOP=0
E S XBRP="PRINT^BARDMR1"
D ^XBDBQUE
D XIT
Q
XIT ;
;
K ^TMP("BARDM",$J)
I $D(IO("S")) S IOP="`"_IOS D ^%ZIS Q
D ^%ZISC
Q
;
PRINT ;
;
S:'$D(BARPSDX) BARPSDX="" ;bar*1.8*22 SDR
U IO
D HDR,HDR2,TOT
D DET ;bar*1.8*22 SDR
Q
;
HDR ;
;S PG=PG+1 ;bar*1.8*22 SDR
S BARPG=BARPG+1 ;bar*1.8*22 SDR
W @IOF,!,BARRDT,?29,"DEBT MANAGEMENT REPORT"
;W:$G(BAROPT)'="B" ?70,"PAGE: ",PG ;bar*1.8*22 SDR
W:$G(BAROPT)'="B" ?70,"PAGE: ",BARPG ;bar*1.8*22 SDR
W !,"A/R PARENT LOCATION: ",BARPNM,!
F I=1:1:80 W "="
Q
HDR2 ;
W !,"ENTITY",?BARPSDX,?53,"AMOUNT"
W !?2,"A/R ACCOUNT",?42,"COUNT",?53,"BILLED",?65,"OUTSTANDING"
W ! F I=1:1:80 W "-"
Q
;
TOT ;PRINT TOTALS
;
F BARL="CYCLE 1","CYCLE 2","CYCLE 3","CYCLE 4" D Q:$G(BARDLQ)
.W !,BARL
.S BARDIT=0 F S BARDIT=$O(^TMP("BARDM",$J,BARL,BARDIT)) Q:BARDIT="" D Q:$G(BARDLQ)
..W !!?2,BARDIT
..S BARDI=0 F S BARDI=$O(^TMP("BARDM",$J,BARL,BARDIT,BARDI)) Q:BARDI="" D Q:$G(BARDLQ)
...W !,?4,BARDI,?40,$J($P(^TMP("BARDM",$J,BARL,BARDIT,BARDI),U),7)
...S X=$P(^TMP("BARDM",$J,BARL,BARDIT,BARDI),U,2) D COMMA^%DTC W ?50,$J(X,13)
...S X=$P(^TMP("BARDM",$J,BARL,BARDIT,BARDI),U,3) D COMMA^%DTC W ?65,$J(X,12)
...I $Y>(IOSL-5) D:$G(BAROPT)'="B" RTRN^BARDMU Q:$G(BARDLQ) D HDR,HDR2
..Q:$G(BARDLQ)
..W !,?40,"-------",?50,"-------------",?65,"------------"
..W !,?2,BARDIT," TOTAL",?40,$J($P(^TMP("BARDM",$J,BARL,BARDIT),U),7)
..S X=$P(^TMP("BARDM",$J,BARL,BARDIT),U,2) D COMMA^%DTC W ?50,$J(X,13)
..S X=$P(^TMP("BARDM",$J,BARL,BARDIT),U,3) D COMMA^%DTC W ?65,$J(X,12)
..I $Y>(IOSL-5) D:$G(BAROPT)'="B" RTRN^BARDMU Q:$G(BARDLQ) D HDR,HDR2
.Q:$G(BARDLQ)
.W !,?40,"-------",?50,"-------------",?65,"------------"
.;W !,?20,L," TOTAL",?40,$J($P(^TMP("BARDM",$J,L),U),7) ;bar*1.8*22 SDR
.W !,?20,BARL," TOTAL",?40,$J(+$P($G(^TMP("BARDM",$J,BARL)),U),7) ;bar*1.8*22 SDR
.;S X=$P(^TMP("BARDM",$J,L),U,2) D COMMA^%DTC W ?50,$J(X,13) ;bar*1.8*22 SDR
.S X=+$P($G(^TMP("BARDM",$J,BARL)),U,2) D COMMA^%DTC W ?50,$J(X,13) ;bar*1.8*22 SDR
.;S X=$P(^TMP("BARDM",$J,L),U,3) D COMMA^%DTC W ?65,$J(X,12) ;bar*1.8*22 SDR
.S X=+$P($G(^TMP("BARDM",$J,BARL)),U,3) D COMMA^%DTC W ?65,$J(X,12) ;bar*1.8*22 SDR
Q:$G(BARDLQ)
I $G(BAROPT)'="B" D RTRN^BARDMU
Q
;start new code bar*1.8*22 SDR
DET ;
W !!
F BARL="CYCLE 1","CYCLE 2","CYCLE 3","CYCLE 4" D
.S BARDIT=""
.F S BARDIT=$O(^TMP("BARDM",$J,"DMIR-DET",BARL,BARDIT)) Q:BARDIT="" D
..S BARDI=""
..F S BARDI=$O(^TMP("BARDM",$J,"DMIR-DET",BARL,BARDIT,BARDI)) Q:BARDI="" D
...S BARDM=0
...F S BARDM=$O(^TMP("BARDM",$J,"DMIR-DET",BARL,BARDIT,BARDI,BARDM)) Q:'BARDM D
....W !,BARL_" "_BARDIT,?25,BARDI,?60,$$GET1^DIQ(90053.05,BARDM,".01","E")
Q
;end new code bar*1.8*22 SDR
;
BARDMR1 ;IHS/OIT/FCJ - DEBT MANAGEMENT-LETTERS READY TO PRINT REPORT
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**22,24**;OCT 26, 2005;Build 69
+2 ;New routine 5-12-2011 for Debt Letter Management
+3 ;
+4 ;This report will provide letters ready to be printed by cycle
+5 ;
+6 ;IHS/SD/POT HEAT152452 2/10/2014 BAR*1.8*.24
ST ;
+1 ;
+2 WRITE !!,"Report for Insurer Letter's to be printed"
+3 SET BARRPT="C"
+4 DO PAR^BARDMU
+5 ;P.OTT HEAT152452 2/10/2014 - BAR*1.8*.24
IF $GET(BARQ)
QUIT
+6 DO RRDT^BARDMU
+7 DO ZIS
+8 QUIT
+9 ;
ZIS ;
+1 DO ZIS^BARDMU
+2 IF $GET(BARQUIT)
GOTO XIT
+3 SET XBRC="CALC^BARDMRU"
SET XBRX="XIT^BARDMR1"
SET XBNS="BAR"
+4 IF $GET(BAROPT)="B"
SET XBRP="VIEWR^XBLM(""PRINT^BARDMR1"")"
SET XBIOP=0
+5 IF '$TEST
SET XBRP="PRINT^BARDMR1"
+6 DO ^XBDBQUE
+7 DO XIT
+8 QUIT
XIT ;
+1 ;
+2 KILL ^TMP("BARDM",$JOB)
+3 IF $DATA(IO("S"))
SET IOP="`"_IOS
DO ^%ZIS
QUIT
+4 DO ^%ZISC
+5 QUIT
+6 ;
PRINT ;
+1 ;
+2 ;bar*1.8*22 SDR
IF '$DATA(BARPSDX)
SET BARPSDX=""
+3 USE IO
+4 DO HDR
DO HDR2
DO TOT
+5 ;bar*1.8*22 SDR
DO DET
+6 QUIT
+7 ;
HDR ;
+1 ;S PG=PG+1 ;bar*1.8*22 SDR
+2 ;bar*1.8*22 SDR
SET BARPG=BARPG+1
+3 WRITE @IOF,!,BARRDT,?29,"DEBT MANAGEMENT REPORT"
+4 ;W:$G(BAROPT)'="B" ?70,"PAGE: ",PG ;bar*1.8*22 SDR
+5 ;bar*1.8*22 SDR
IF $GET(BAROPT)'="B"
WRITE ?70,"PAGE: ",BARPG
+6 WRITE !,"A/R PARENT LOCATION: ",BARPNM,!
+7 FOR I=1:1:80
WRITE "="
+8 QUIT
HDR2 ;
+1 WRITE !,"ENTITY",?BARPSDX,?53,"AMOUNT"
+2 WRITE !?2,"A/R ACCOUNT",?42,"COUNT",?53,"BILLED",?65,"OUTSTANDING"
+3 WRITE !
FOR I=1:1:80
WRITE "-"
+4 QUIT
+5 ;
TOT ;PRINT TOTALS
+1 ;
+2 FOR BARL="CYCLE 1","CYCLE 2","CYCLE 3","CYCLE 4"
Begin DoDot:1
+3 WRITE !,BARL
+4 SET BARDIT=0
FOR
SET BARDIT=$ORDER(^TMP("BARDM",$JOB,BARL,BARDIT))
IF BARDIT=""
QUIT
Begin DoDot:2
+5 WRITE !!?2,BARDIT
+6 SET BARDI=0
FOR
SET BARDI=$ORDER(^TMP("BARDM",$JOB,BARL,BARDIT,BARDI))
IF BARDI=""
QUIT
Begin DoDot:3
+7 WRITE !,?4,BARDI,?40,$JUSTIFY($PIECE(^TMP("BARDM",$JOB,BARL,BARDIT,BARDI),U),7)
+8 SET X=$PIECE(^TMP("BARDM",$JOB,BARL,BARDIT,BARDI),U,2)
DO COMMA^%DTC
WRITE ?50,$JUSTIFY(X,13)
+9 SET X=$PIECE(^TMP("BARDM",$JOB,BARL,BARDIT,BARDI),U,3)
DO COMMA^%DTC
WRITE ?65,$JUSTIFY(X,12)
+10 IF $Y>(IOSL-5)
IF $GET(BAROPT)'="B"
DO RTRN^BARDMU
IF $GET(BARDLQ)
QUIT
DO HDR
DO HDR2
End DoDot:3
IF $GET(BARDLQ)
QUIT
+11 IF $GET(BARDLQ)
QUIT
+12 WRITE !,?40,"-------",?50,"-------------",?65,"------------"
+13 WRITE !,?2,BARDIT," TOTAL",?40,$JUSTIFY($PIECE(^TMP("BARDM",$JOB,BARL,BARDIT),U),7)
+14 SET X=$PIECE(^TMP("BARDM",$JOB,BARL,BARDIT),U,2)
DO COMMA^%DTC
WRITE ?50,$JUSTIFY(X,13)
+15 SET X=$PIECE(^TMP("BARDM",$JOB,BARL,BARDIT),U,3)
DO COMMA^%DTC
WRITE ?65,$JUSTIFY(X,12)
+16 IF $Y>(IOSL-5)
IF $GET(BAROPT)'="B"
DO RTRN^BARDMU
IF $GET(BARDLQ)
QUIT
DO HDR
DO HDR2
End DoDot:2
IF $GET(BARDLQ)
QUIT
+17 IF $GET(BARDLQ)
QUIT
+18 WRITE !,?40,"-------",?50,"-------------",?65,"------------"
+19 ;W !,?20,L," TOTAL",?40,$J($P(^TMP("BARDM",$J,L),U),7) ;bar*1.8*22 SDR
+20 ;bar*1.8*22 SDR
WRITE !,?20,BARL," TOTAL",?40,$JUSTIFY(+$PIECE($GET(^TMP("BARDM",$JOB,BARL)),U),7)
+21 ;S X=$P(^TMP("BARDM",$J,L),U,2) D COMMA^%DTC W ?50,$J(X,13) ;bar*1.8*22 SDR
+22 ;bar*1.8*22 SDR
SET X=+$PIECE($GET(^TMP("BARDM",$JOB,BARL)),U,2)
DO COMMA^%DTC
WRITE ?50,$JUSTIFY(X,13)
+23 ;S X=$P(^TMP("BARDM",$J,L),U,3) D COMMA^%DTC W ?65,$J(X,12) ;bar*1.8*22 SDR
+24 ;bar*1.8*22 SDR
SET X=+$PIECE($GET(^TMP("BARDM",$JOB,BARL)),U,3)
DO COMMA^%DTC
WRITE ?65,$JUSTIFY(X,12)
End DoDot:1
IF $GET(BARDLQ)
QUIT
+25 IF $GET(BARDLQ)
QUIT
+26 IF $GET(BAROPT)'="B"
DO RTRN^BARDMU
+27 QUIT
+28 ;start new code bar*1.8*22 SDR
DET ;
+1 WRITE !!
+2 FOR BARL="CYCLE 1","CYCLE 2","CYCLE 3","CYCLE 4"
Begin DoDot:1
+3 SET BARDIT=""
+4 FOR
SET BARDIT=$ORDER(^TMP("BARDM",$JOB,"DMIR-DET",BARL,BARDIT))
IF BARDIT=""
QUIT
Begin DoDot:2
+5 SET BARDI=""
+6 FOR
SET BARDI=$ORDER(^TMP("BARDM",$JOB,"DMIR-DET",BARL,BARDIT,BARDI))
IF BARDI=""
QUIT
Begin DoDot:3
+7 SET BARDM=0
+8 FOR
SET BARDM=$ORDER(^TMP("BARDM",$JOB,"DMIR-DET",BARL,BARDIT,BARDI,BARDM))
IF 'BARDM
QUIT
Begin DoDot:4
+9 WRITE !,BARL_" "_BARDIT,?25,BARDI,?60,$$GET1^DIQ(90053.05,BARDM,".01","E")
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+10 QUIT
+11 ;end new code bar*1.8*22 SDR
+12 ;
