BARDMRQN ;IHS/OIT/FCJ - DEBT MANAGEMENT-QUE LETTER REPORT
;;1.8;IHS ACCOUNTS RECEIVABLE;**22,23**;OCT 26, 2005;Build 38
;New routine 5-12-2011 for Debt Letter Management
;
;This report shows recently printed letters by cycle, Insurer and detail
;
;CODE CLONED FROM BARDMRQ, CALLS CALC^BARDMRQC ;P.OTT
;MAY 2013 NOHEAT P.OTTIS ADDED LOOP TO DISPLAY LIST AFTER RETURN FROM SELD
;AUG 2013 NOHEAT P.OTTIS ADDED SUMMARIES (# OF PRINTED BILLS - BARTOT1, TOT $$$ - BARTOT2)
;
ST ;
;
;
S BMCQ=0,BARRPT="Q",BARSEQ=0
D SELC G:$D(DIRUT) XIT
D SELI G:$D(DIRUT) XIT
D:'$D(BARDCI) SELA G:$D(DIRUT) XIT
D CALC^BARDMRQC
G:$G(BARQ) XIT
TRT ;<--------------
S BARSEQ=0
D PRINT
I (BMCQ=1)&(BARCY'="A") G XIT
D SELD
I Y<1 G XIT
G TRT ;-----> ;P.OTT MAY 2013
XIT ;
K DIR
K BARL
Q
;
SELC ;SELECT CYCLE
S DIR(0)="S^1:CYCLE 1;2:CYCLE 2;3:CYCLE 3;4:CYCLE 4;A:ALL"
S DIR("A")="Select Cycle to View"
S DIR("B")="All",DIR("L")=""
S DIR("?")="Enter 1, 2, 3, 4 or A to view or all cycles"
S DIR("?",1)=" 1 - CYCLE 1"
S DIR("?",2)=" 2 - CYCLE 2"
S DIR("?",3)=" 3 - CYCLE 3"
S DIR("?",4)=" 4 - CYCLE 4"
D ^DIR
Q:$D(DIRUT)
S BARCY=Y,BARCYN=Y(0)
K DIR Q
;
SELI ;SELECT INSURANCE TYPE
S DIC="^BAR(90052.06,"_DUZ(2)_","_DUZ(2)_",19,"
S DIC(0)="AEQZ",DIC("A")="View by Insurer Type: "
D ^DIC
Q:$D(DUOUT)
S:$G(Y(0)) BARDCI=$$GET1^DIQ(90053.03,Y(0),".01","E")
I $G(BARDCI)["NON-BEN" S BARDCI="PATIENT" ;non-bens are listed under PATIENT in ^TMP("BARDMQN",$J) global
K DIC,DA
Q
;
SELA ;SELECT ACCOUNT
S DIC="^BARAC("_DUZ(2)_","
S DIC(0)="AEQZ",DIC("A")="View by Account: "
S DIC("S")="I $P(^(0),U,7)=""Y"""
D ^DIC
Q:$D(DUOUT)
I $G(Y(0)) S BARDAC=$P(Y,U),BARDCA=$$VAL^XBDIQ1(90050.02,BARDAC,.01)
K DIC,DA
Q
SELD ;SELECT DETAIL
S BARSEQ=$G(^TMP("BARDM",$J,"QN"),0)
I 'BARSEQ W !!,"** NO DATA TO LIST **" Q
S DIR(0)="Y"
S DIR("A")="Show Detail"
S DIR("B")="N"
W ! D ^DIR
Q:Y=0
I Y="^" S Y=-1 Q ;P.OTT
K DIR
S DIR(0)="NO^1:"_BARSEQ
S DIR("A")="What sequence number"
D ^DIR
I Y>0 S BARSEQ=Y D
. D RRDT^BARDMU
. S BARDL=$P(^TMP("BARDM",$J,"QN",BARSEQ),U),BARDIT=$P(^(BARSEQ),U,2),BARDI=$P(^(BARSEQ),U,3)
. D HDR2,DET
K DIR
Q
PRINT ;
D HDR
S BARGTOT1=0,BARGTOT2=0 ;GRAND TOTALS # OF LETTERS;AMOUNT ;P.OTT
I BARCY="A" D
. F BARDL="CYCLE 1","CYCLE 2","CYCLE 3","CYCLE 4" Q:$G(BARDLQ) D TOT
. D GTOT ;-----------P.OTT AUG 2013
E S BARDL=BARCYN D TOT
Q
HDR ;
W @IOF
I $G(BARMODE)="B" D
. N BARTMP
. I $G(BARBAT) D
. . S BARTMP=$G(^BARDMLG(DUZ(2),BARBAT,0))
. . W !,"Printed letters in batch ",$$DATE($G(BARTMP))
I $G(BARMODE)="D",$G(BARFROM),$G(BARTO) D
. W !,"Printed letters in time period ",$$DATE($G(BARFROM))," - ",$$DATE($G(BARTO))
. ;>S Y=2690720.163 D DD^%DT W Y ;JUL 20, 1969@1630
W !,"SEQ",?6,"CYCLE",?13,"INS TYPE/INS-ACCOUNT",?55,"# OF BILLS",?69,"AMOUNT",!
F I=1:1:80 W "-"
Q
HDR2 ;
S BARPG=BARPG+1
W @IOF,!,BARRDT,?23,"Debt Letter Print Report",?70,"PAGE: ",BARPG
W !!,"A/R PARENT LOCATION: ",BARPSAT(DUZ(2),.01)
W ?65,BARDL
W !,"A/R ACCOUNT: ",BARDI,?62,"PERIOD: ",BARPCD($P(BARDL," ",2))," Days"
W ! F I=1:1:80 W "="
W !,?40,"SERVICE",?49,"BILLED",?60,"BILLED"
W !,?2,"HRN",?8,"BILL #",?16,"PATIENT",?40,"DATE",?49,"DATE",?60,"AMOUNT",?72,"BALANCE"
W ! F I=1:1:80 W "-"
Q
TOT ;PRINT TOTALS
I $P($G(^TMP("BARDM",$J,"QN",BARDL)),U)=0 W !!,BARDL," Does not contain any queued Letters" S BMCQ=1 Q
S BARTOT1=0,BARTOT2=0 ;# OF LETTERS;AMOUNT ;P.OTT
S BARDIT=0 F S BARDIT=$O(^TMP("BARDM",$J,"QN",BARDL,BARDIT)) Q:BARDIT="" D Q:$G(BARDLQ)
.S BARDI=0 F S BARDI=$O(^TMP("BARDM",$J,"QN",BARDL,BARDIT,BARDI)) Q:BARDI="" D Q:$G(BARDLQ)
..I $D(BARDCA) Q:BARDI'=BARDCA
..I $D(BARDCI) Q:BARDIT'=BARDCI
..S BARSEQ=BARSEQ+1,BARDITI=BARDIT_"/"_BARDI
.. S ^TMP("BARDM",$J,"QN")=BARSEQ ;P.OTT 4/11
..W !,BARSEQ,?5,BARDL,?13,$E(BARDITI,1,42),?55,$J($P(^TMP("BARDM",$J,"QN",BARDL,BARDIT,BARDI),U),7)
.. S BARTOT1=BARTOT1+$P(^TMP("BARDM",$J,"QN",BARDL,BARDIT,BARDI),U)
..S X=$P(^TMP("BARDM",$J,"QN",BARDL,BARDIT,BARDI),U,3)
.. S BARTOT2=BARTOT2+X
.. D COMMA^%DTC W ?66,$J(X,12)
..S ^TMP("BARDM",$J,"QN",BARSEQ)=BARDL_U_BARDIT_U_BARDI_U_$E(L,7)
..I $Y>(IOSL-6) W ! D RTRN^BARDMU Q:$G(BARDLQ) D HDR
;-----------P.OTT AUG 2013
I $Y>(IOSL-6) W ! D RTRN^BARDMU Q:$G(BARDLQ) D HDR
W !,?55," ====",?66,"==========="
W !,"-- TOTAL:"
W ?55,$J(BARTOT1,7),?65,$J(BARTOT2,12,2)
S BARGTOT1=BARGTOT1+BARTOT1
S BARGTOT2=BARGTOT2+BARTOT2
W !
Q
GTOT W !,?55," ====",?66,"==========="
W !,"-- GRAND TOTAL:"
W ?55,$J(BARGTOT1,7),?65,$J(BARGTOT2,12,2)
W !
Q
DET ;DETAIL
S BARDLQ=""
S BARBIL=0 F S BARBIL=$O(^TMP("BARDM",$J,"QN",BARDL,BARDIT,BARDI,BARBIL)) Q:BARBIL="" D Q:$G(BARDLQ)
. S DFN=$P(^TMP("BARDM",$J,"QN",BARDL,BARDIT,BARDI,BARBIL),U),BARHRN=$P(^AUPNPAT(DFN,41,DUZ(2),0),U,2),BARPAT=$P(^DPT(DFN,0),U)
. S BARDT=$P(^TMP("BARDM",$J,"QN",BARDL,BARDIT,BARDI,BARBIL),U,2)
. S BARSDT=$E(BARDT,4,5)_"/"_$E(BARDT,6,7)_"/"_$E(BARDT,2,3)
. S BARDT=$P(^TMP("BARDM",$J,"QN",BARDL,BARDIT,BARDI,BARBIL),U,3)
. S BARBDT=$E(BARDT,4,5)_"/"_$E(BARDT,6,7)_"/"_$E(BARDT,2,3)
. W !,BARHRN,?7,BARBIL,?16,$E(BARPAT,1,24),?40,BARSDT,?49,BARBDT
. S X=$P(^TMP("BARDM",$J,"QN",BARDL,BARDIT,BARDI,BARBIL),U,4) W ?58,$J(X,10,2) ;D COMMA^%DTC W
. S X=$P(^TMP("BARDM",$J,"QN",BARDL,BARDIT,BARDI,BARBIL),U,5) W ?70,$J(X,10,2) ;D COMMA^%DTC W ?60,X
. I $Y>(IOSL-6) W ! D RTRN^BARDMU Q:$G(BARDLQ) D HDR2
Q:$G(BARDLQ)
W !,?58,"----------",?70,"----------"
S TMP=^TMP("BARDM",$J,"QN",BARDL,BARDIT,BARDI)
W !,"TOTAL",?38,$P(TMP,U)," Bill(s)"
S X=$P(TMP,U,2) W ?58,$J(X,10,2)
S X=$P(TMP,U,3) W ?70,$J(X,10,2)
W ! D RTRN^BARDMU Q:$G(BARDLQ)
Q
DATE(Y) ;
S Y=Y\1 D DD^%DT ;JUL 20, 1969@1630
Q $P(Y,"@") ;
;---EOR--
BARDMRQN ;IHS/OIT/FCJ - DEBT MANAGEMENT-QUE LETTER REPORT
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**22,23**;OCT 26, 2005;Build 38
+2 ;New routine 5-12-2011 for Debt Letter Management
+3 ;
+4 ;This report shows recently printed letters by cycle, Insurer and detail
+5 ;
+6 ;CODE CLONED FROM BARDMRQ, CALLS CALC^BARDMRQC ;P.OTT
+7 ;MAY 2013 NOHEAT P.OTTIS ADDED LOOP TO DISPLAY LIST AFTER RETURN FROM SELD
+8 ;AUG 2013 NOHEAT P.OTTIS ADDED SUMMARIES (# OF PRINTED BILLS - BARTOT1, TOT $$$ - BARTOT2)
+9 ;
ST ;
+1 ;
+2 ;
+3 SET BMCQ=0
SET BARRPT="Q"
SET BARSEQ=0
+4 DO SELC
IF $DATA(DIRUT)
GOTO XIT
+5 DO SELI
IF $DATA(DIRUT)
GOTO XIT
+6 IF '$DATA(BARDCI)
DO SELA
IF $DATA(DIRUT)
GOTO XIT
+7 DO CALC^BARDMRQC
+8 IF $GET(BARQ)
GOTO XIT
TRT ;<--------------
+1 SET BARSEQ=0
+2 DO PRINT
+3 IF (BMCQ=1)&(BARCY'="A")
GOTO XIT
+4 DO SELD
+5 IF Y<1
GOTO XIT
+6 ;-----> ;P.OTT MAY 2013
GOTO TRT
XIT ;
+1 KILL DIR
+2 KILL BARL
+3 QUIT
+4 ;
SELC ;SELECT CYCLE
+1 SET DIR(0)="S^1:CYCLE 1;2:CYCLE 2;3:CYCLE 3;4:CYCLE 4;A:ALL"
+2 SET DIR("A")="Select Cycle to View"
+3 SET DIR("B")="All"
SET DIR("L")=""
+4 SET DIR("?")="Enter 1, 2, 3, 4 or A to view or all cycles"
+5 SET DIR("?",1)=" 1 - CYCLE 1"
+6 SET DIR("?",2)=" 2 - CYCLE 2"
+7 SET DIR("?",3)=" 3 - CYCLE 3"
+8 SET DIR("?",4)=" 4 - CYCLE 4"
+9 DO ^DIR
+10 IF $DATA(DIRUT)
QUIT
+11 SET BARCY=Y
SET BARCYN=Y(0)
+12 KILL DIR
QUIT
+13 ;
SELI ;SELECT INSURANCE TYPE
+1 SET DIC="^BAR(90052.06,"_DUZ(2)_","_DUZ(2)_",19,"
+2 SET DIC(0)="AEQZ"
SET DIC("A")="View by Insurer Type: "
+3 DO ^DIC
+4 IF $DATA(DUOUT)
QUIT
+5 IF $GET(Y(0))
SET BARDCI=$$GET1^DIQ(90053.03,Y(0),".01","E")
+6 ;non-bens are listed under PATIENT in ^TMP("BARDMQN",$J) global
IF $GET(BARDCI)["NON-BEN"
SET BARDCI="PATIENT"
+7 KILL DIC,DA
+8 QUIT
+9 ;
SELA ;SELECT ACCOUNT
+1 SET DIC="^BARAC("_DUZ(2)_","
+2 SET DIC(0)="AEQZ"
SET DIC("A")="View by Account: "
+3 SET DIC("S")="I $P(^(0),U,7)=""Y"""
+4 DO ^DIC
+5 IF $DATA(DUOUT)
QUIT
+6 IF $GET(Y(0))
SET BARDAC=$PIECE(Y,U)
SET BARDCA=$$VAL^XBDIQ1(90050.02,BARDAC,.01)
+7 KILL DIC,DA
+8 QUIT
SELD ;SELECT DETAIL
+1 SET BARSEQ=$GET(^TMP("BARDM",$JOB,"QN"),0)
+2 IF 'BARSEQ
WRITE !!,"** NO DATA TO LIST **"
QUIT
+3 SET DIR(0)="Y"
+4 SET DIR("A")="Show Detail"
+5 SET DIR("B")="N"
+6 WRITE !
DO ^DIR
+7 IF Y=0
QUIT
+8 ;P.OTT
IF Y="^"
SET Y=-1
QUIT
+9 KILL DIR
+10 SET DIR(0)="NO^1:"_BARSEQ
+11 SET DIR("A")="What sequence number"
+12 DO ^DIR
+13 IF Y>0
SET BARSEQ=Y
Begin DoDot:1
+14 DO RRDT^BARDMU
+15 SET BARDL=$PIECE(^TMP("BARDM",$JOB,"QN",BARSEQ),U)
SET BARDIT=$PIECE(^(BARSEQ),U,2)
SET BARDI=$PIECE(^(BARSEQ),U,3)
+16 DO HDR2
DO DET
End DoDot:1
+17 KILL DIR
+18 QUIT
PRINT ;
+1 DO HDR
+2 ;GRAND TOTALS # OF LETTERS;AMOUNT ;P.OTT
SET BARGTOT1=0
SET BARGTOT2=0
+3 IF BARCY="A"
Begin DoDot:1
+4 FOR BARDL="CYCLE 1","CYCLE 2","CYCLE 3","CYCLE 4"
IF $GET(BARDLQ)
QUIT
DO TOT
+5 ;-----------P.OTT AUG 2013
DO GTOT
End DoDot:1
+6 IF '$TEST
SET BARDL=BARCYN
DO TOT
+7 QUIT
HDR ;
+1 WRITE @IOF
+2 IF $GET(BARMODE)="B"
Begin DoDot:1
+3 NEW BARTMP
+4 IF $GET(BARBAT)
Begin DoDot:2
+5 SET BARTMP=$GET(^BARDMLG(DUZ(2),BARBAT,0))
+6 WRITE !,"Printed letters in batch ",$$DATE($GET(BARTMP))
End DoDot:2
End DoDot:1
+7 IF $GET(BARMODE)="D"
IF $GET(BARFROM)
IF $GET(BARTO)
Begin DoDot:1
+8 WRITE !,"Printed letters in time period ",$$DATE($GET(BARFROM))," - ",$$DATE($GET(BARTO))
+9 ;>S Y=2690720.163 D DD^%DT W Y ;JUL 20, 1969@1630
End DoDot:1
+10 WRITE !,"SEQ",?6,"CYCLE",?13,"INS TYPE/INS-ACCOUNT",?55,"# OF BILLS",?69,"AMOUNT",!
+11 FOR I=1:1:80
WRITE "-"
+12 QUIT
HDR2 ;
+1 SET BARPG=BARPG+1
+2 WRITE @IOF,!,BARRDT,?23,"Debt Letter Print Report",?70,"PAGE: ",BARPG
+3 WRITE !!,"A/R PARENT LOCATION: ",BARPSAT(DUZ(2),.01)
+4 WRITE ?65,BARDL
+5 WRITE !,"A/R ACCOUNT: ",BARDI,?62,"PERIOD: ",BARPCD($PIECE(BARDL," ",2))," Days"
+6 WRITE !
FOR I=1:1:80
WRITE "="
+7 WRITE !,?40,"SERVICE",?49,"BILLED",?60,"BILLED"
+8 WRITE !,?2,"HRN",?8,"BILL #",?16,"PATIENT",?40,"DATE",?49,"DATE",?60,"AMOUNT",?72,"BALANCE"
+9 WRITE !
FOR I=1:1:80
WRITE "-"
+10 QUIT
TOT ;PRINT TOTALS
+1 IF $PIECE($GET(^TMP("BARDM",$JOB,"QN",BARDL)),U)=0
WRITE !!,BARDL," Does not contain any queued Letters"
SET BMCQ=1
QUIT
+2 ;# OF LETTERS;AMOUNT ;P.OTT
SET BARTOT1=0
SET BARTOT2=0
+3 SET BARDIT=0
FOR
SET BARDIT=$ORDER(^TMP("BARDM",$JOB,"QN",BARDL,BARDIT))
IF BARDIT=""
QUIT
Begin DoDot:1
+4 SET BARDI=0
FOR
SET BARDI=$ORDER(^TMP("BARDM",$JOB,"QN",BARDL,BARDIT,BARDI))
IF BARDI=""
QUIT
Begin DoDot:2
+5 IF $DATA(BARDCA)
IF BARDI'=BARDCA
QUIT
+6 IF $DATA(BARDCI)
IF BARDIT'=BARDCI
QUIT
+7 SET BARSEQ=BARSEQ+1
SET BARDITI=BARDIT_"/"_BARDI
+8 ;P.OTT 4/11
SET ^TMP("BARDM",$JOB,"QN")=BARSEQ
+9 WRITE !,BARSEQ,?5,BARDL,?13,$EXTRACT(BARDITI,1,42),?55,$JUSTIFY($PIECE(^TMP("BARDM",$JOB,"QN",BARDL,BARDIT,BARDI),U),7)
+10 SET BARTOT1=BARTOT1+$PIECE(^TMP("BARDM",$JOB,"QN",BARDL,BARDIT,BARDI),U)
+11 SET X=$PIECE(^TMP("BARDM",$JOB,"QN",BARDL,BARDIT,BARDI),U,3)
+12 SET BARTOT2=BARTOT2+X
+13 DO COMMA^%DTC
WRITE ?66,$JUSTIFY(X,12)
+14 SET ^TMP("BARDM",$JOB,"QN",BARSEQ)=BARDL_U_BARDIT_U_BARDI_U_$EXTRACT(L,7)
+15 IF $Y>(IOSL-6)
WRITE !
DO RTRN^BARDMU
IF $GET(BARDLQ)
QUIT
DO HDR
End DoDot:2
IF $GET(BARDLQ)
QUIT
End DoDot:1
IF $GET(BARDLQ)
QUIT
+16 ;-----------P.OTT AUG 2013
+17 IF $Y>(IOSL-6)
WRITE !
DO RTRN^BARDMU
IF $GET(BARDLQ)
QUIT
DO HDR
+18 WRITE !,?55," ====",?66,"==========="
+19 WRITE !,"-- TOTAL:"
+20 WRITE ?55,$JUSTIFY(BARTOT1,7),?65,$JUSTIFY(BARTOT2,12,2)
+21 SET BARGTOT1=BARGTOT1+BARTOT1
+22 SET BARGTOT2=BARGTOT2+BARTOT2
+23 WRITE !
+24 QUIT
GTOT WRITE !,?55," ====",?66,"==========="
+1 WRITE !,"-- GRAND TOTAL:"
+2 WRITE ?55,$JUSTIFY(BARGTOT1,7),?65,$JUSTIFY(BARGTOT2,12,2)
+3 WRITE !
+4 QUIT
DET ;DETAIL
+1 SET BARDLQ=""
+2 SET BARBIL=0
FOR
SET BARBIL=$ORDER(^TMP("BARDM",$JOB,"QN",BARDL,BARDIT,BARDI,BARBIL))
IF BARBIL=""
QUIT
Begin DoDot:1
+3 SET DFN=$PIECE(^TMP("BARDM",$JOB,"QN",BARDL,BARDIT,BARDI,BARBIL),U)
SET BARHRN=$PIECE(^AUPNPAT(DFN,41,DUZ(2),0),U,2)
SET BARPAT=$PIECE(^DPT(DFN,0),U)
+4 SET BARDT=$PIECE(^TMP("BARDM",$JOB,"QN",BARDL,BARDIT,BARDI,BARBIL),U,2)
+5 SET BARSDT=$EXTRACT(BARDT,4,5)_"/"_$EXTRACT(BARDT,6,7)_"/"_$EXTRACT(BARDT,2,3)
+6 SET BARDT=$PIECE(^TMP("BARDM",$JOB,"QN",BARDL,BARDIT,BARDI,BARBIL),U,3)
+7 SET BARBDT=$EXTRACT(BARDT,4,5)_"/"_$EXTRACT(BARDT,6,7)_"/"_$EXTRACT(BARDT,2,3)
+8 WRITE !,BARHRN,?7,BARBIL,?16,$EXTRACT(BARPAT,1,24),?40,BARSDT,?49,BARBDT
+9 ;D COMMA^%DTC W
SET X=$PIECE(^TMP("BARDM",$JOB,"QN",BARDL,BARDIT,BARDI,BARBIL),U,4)
WRITE ?58,$JUSTIFY(X,10,2)
+10 ;D COMMA^%DTC W ?60,X
SET X=$PIECE(^TMP("BARDM",$JOB,"QN",BARDL,BARDIT,BARDI,BARBIL),U,5)
WRITE ?70,$JUSTIFY(X,10,2)
+11 IF $Y>(IOSL-6)
WRITE !
DO RTRN^BARDMU
IF $GET(BARDLQ)
QUIT
DO HDR2
End DoDot:1
IF $GET(BARDLQ)
QUIT
+12 IF $GET(BARDLQ)
QUIT
+13 WRITE !,?58,"----------",?70,"----------"
+14 SET TMP=^TMP("BARDM",$JOB,"QN",BARDL,BARDIT,BARDI)
+15 WRITE !,"TOTAL",?38,$PIECE(TMP,U)," Bill(s)"
+16 SET X=$PIECE(TMP,U,2)
WRITE ?58,$JUSTIFY(X,10,2)
+17 SET X=$PIECE(TMP,U,3)
WRITE ?70,$JUSTIFY(X,10,2)
+18 WRITE !
DO RTRN^BARDMU
IF $GET(BARDLQ)
QUIT
+19 QUIT
DATE(Y) ;
+1 ;JUL 20, 1969@1630
SET Y=Y\1
DO DD^%DT
+2 ;
QUIT $PIECE(Y,"@")
+3 ;---EOR--
