BARDMRQ ;IHS/OIT/FCJ - DEBT MANAGEMENT-QUE LETTER REPORT
;;1.8;IHS ACCOUNTS RECEIVABLE;**22,23,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, Insurer and detail
;IHS/SD/POT SEP 2012 ADDED PAUSE AFTER MESSAGE- BAR*1.8*.23
;IHS/SD/POT MAY 2013 CORRECTED SELD (1-0) & ALLOWED LOOP TO SELECT DETAILS - BAR*1.8*.24
;IHS/SD/POT HEAT152452 2/10/2014 CHK IF PAR/SAT FILE CORECTLY SET UP - BAR*1.8*.24
ST ;
;
D PAR^BARDMU
Q:$G(BARQ) ;P.OTT HEAT152452 2/10/2014 - BAR*1.8*.24
N BARXYZ ;P.OTT
K ^TMP("BARDM",$J) ;
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^BARDMRU
G:$G(BARQ) XIT
;D PRINT
;Q:(BMCQ=1)&(BARCY'="A")
;I 'BARSEQ W !!,"**NO DATA TO PRINT **" H 3 G XIT ;P.OTT
;S BARXYZ=BARSEQ ;KEEP MAX VALUE
;F S BARSEQ=BARXYZ D SELD Q:(BMCQ=1)
TRT ;<--------------
S BARSEQ=0
D PRINT
Q:(BMCQ=1)&(BARCY'="A")
I 'BARSEQ W !!,"**NO DATA TO PRINT **" H 3 G XIT ;- BAR*1.8*.23
D SELD
I Y<1 G XIT
G TRT ;-----> ;BAR*1.8*.23
XIT ;
K ^TMP("BARDM",$J)
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("BARDM",$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 BMCQ=0
S DIR(0)="Y"
S DIR("A")="Show Detail"
S DIR("B")="N"
W ! D ^DIR
I Y=0 S BMCQ=1 Q
K DIR
S DIR(0)="NO^1:"_BARSEQ
S DIR("A")="What sequence number"
D ^DIR
I Y<1 S BMCQ=1 Q
I Y>0 S BARSEQ=Y D
.D RRDT^BARDMU
.S BARDL=$P(^TMP("BARDM",$J,BARSEQ),U),BARDIT=$P(^(BARSEQ),U,2),BARDI=$P(^(BARSEQ),U,3) ;
.D HDR2,DET
K DIR
Q
PRINT ;
D HDR
I BARCY="A" F BARDL="CYCLE 1","CYCLE 2","CYCLE 3","CYCLE 4" Q:$G(BARDLQ) D TOT ;
E S BARDL=BARCYN D TOT ;
Q
HDR ;
W @IOF
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,"LETTERS IN THE QUEUE READY TO PRINT",?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,BARDL)),U)=0 W !!,BARDL," Does not contain any queued Letters" D S BMCQ=1 Q ; P.OTT PAUSE
. K DIR S (X,Y)=""
. S DIR(0)="E"
. S DIR("A")="Enter RETURN to Continue"
. D ^DIR
. K DIR
. QUIT
S BARDIT=0 F S BARDIT=$O(^TMP("BARDM",$J,BARDL,BARDIT)) Q:BARDIT="" D Q:$G(BARDLQ) ;
.S BARDI=0 F S BARDI=$O(^TMP("BARDM",$J,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
..W !,BARSEQ,?5,BARDL,?13,$E(BARDITI,1,42),?55,$J($P(^TMP("BARDM",$J,BARDL,BARDIT,BARDI),U),7) ;
..S X=$P(^TMP("BARDM",$J,BARDL,BARDIT,BARDI),U,3) D COMMA^%DTC W ?66,$J(X,12) ;
..S ^TMP("BARDM",$J,BARSEQ)=BARDL_U_BARDIT_U_BARDI_U_$E(L,7) ;
..I $Y>(IOSL-6) W ! D RTRN^BARDMU Q:$G(BARDLQ) D HDR
Q
DET ;DETAIL
S BARDLQ=""
S BARBIL=0 F S BARBIL=$O(^TMP("BARDM",$J,BARDL,BARDIT,BARDI,BARBIL)) Q:BARBIL="" D Q:$G(BARDLQ)
.S DFN=$P(^TMP("BARDM",$J,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,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,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,BARDL,BARDIT,BARDI,BARBIL),U,4) W ?58,$J(X,10,2) ;D COMMA^%DTC W
.S X=$P(^TMP("BARDM",$J,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,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
BARDMRQ ;IHS/OIT/FCJ - DEBT MANAGEMENT-QUE LETTER REPORT
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**22,23,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, Insurer and detail
+5 ;IHS/SD/POT SEP 2012 ADDED PAUSE AFTER MESSAGE- BAR*1.8*.23
+6 ;IHS/SD/POT MAY 2013 CORRECTED SELD (1-0) & ALLOWED LOOP TO SELECT DETAILS - BAR*1.8*.24
+7 ;IHS/SD/POT HEAT152452 2/10/2014 CHK IF PAR/SAT FILE CORECTLY SET UP - BAR*1.8*.24
ST ;
+1 ;
+2 DO PAR^BARDMU
+3 ;P.OTT HEAT152452 2/10/2014 - BAR*1.8*.24
IF $GET(BARQ)
QUIT
+4 ;P.OTT
NEW BARXYZ
+5 ;
KILL ^TMP("BARDM",$JOB)
+6 SET BMCQ=0
SET BARRPT="Q"
SET BARSEQ=0
+7 DO SELC
IF $DATA(DIRUT)
GOTO XIT
+8 DO SELI
IF $DATA(DIRUT)
GOTO XIT
+9 IF '$DATA(BARDCI)
DO SELA
IF $DATA(DIRUT)
GOTO XIT
+10 DO CALC^BARDMRU
+11 IF $GET(BARQ)
GOTO XIT
+12 ;D PRINT
+13 ;Q:(BMCQ=1)&(BARCY'="A")
+14 ;I 'BARSEQ W !!,"**NO DATA TO PRINT **" H 3 G XIT ;P.OTT
+15 ;S BARXYZ=BARSEQ ;KEEP MAX VALUE
+16 ;F S BARSEQ=BARXYZ D SELD Q:(BMCQ=1)
TRT ;<--------------
+1 SET BARSEQ=0
+2 DO PRINT
+3 IF (BMCQ=1)&(BARCY'="A")
QUIT
+4 ;- BAR*1.8*.23
IF 'BARSEQ
WRITE !!,"**NO DATA TO PRINT **"
HANG 3
GOTO XIT
+5 DO SELD
+6 IF Y<1
GOTO XIT
+7 ;-----> ;BAR*1.8*.23
GOTO TRT
XIT ;
+1 KILL ^TMP("BARDM",$JOB)
+2 KILL DIR
+3 KILL BARL
+4 QUIT
+5 ;
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("BARDM",$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 BMCQ=0
+2 SET DIR(0)="Y"
+3 SET DIR("A")="Show Detail"
+4 SET DIR("B")="N"
+5 WRITE !
DO ^DIR
+6 IF Y=0
SET BMCQ=1
QUIT
+7 KILL DIR
+8 SET DIR(0)="NO^1:"_BARSEQ
+9 SET DIR("A")="What sequence number"
+10 DO ^DIR
+11 IF Y<1
SET BMCQ=1
QUIT
+12 IF Y>0
SET BARSEQ=Y
Begin DoDot:1
+13 DO RRDT^BARDMU
+14 ;
SET BARDL=$PIECE(^TMP("BARDM",$JOB,BARSEQ),U)
SET BARDIT=$PIECE(^(BARSEQ),U,2)
SET BARDI=$PIECE(^(BARSEQ),U,3)
+15 DO HDR2
DO DET
End DoDot:1
+16 KILL DIR
+17 QUIT
PRINT ;
+1 DO HDR
+2 ;
IF BARCY="A"
FOR BARDL="CYCLE 1","CYCLE 2","CYCLE 3","CYCLE 4"
IF $GET(BARDLQ)
QUIT
DO TOT
+3 ;
IF '$TEST
SET BARDL=BARCYN
DO TOT
+4 QUIT
HDR ;
+1 WRITE @IOF
+2 WRITE !,"SEQ",?6,"CYCLE",?13,"INS TYPE/INS-ACCOUNT",?55,"# OF BILLS",?69,"AMOUNT",!
+3 FOR I=1:1:80
WRITE "-"
+4 QUIT
HDR2 ;
+1 ;
SET BARPG=BARPG+1
+2 ;
WRITE @IOF,!,BARRDT,?23,"LETTERS IN THE QUEUE READY TO PRINT",?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 ; P.OTT PAUSE
IF $PIECE($GET(^TMP("BARDM",$JOB,BARDL)),U)=0
WRITE !!,BARDL," Does not contain any queued Letters"
Begin DoDot:1
+2 KILL DIR
SET (X,Y)=""
+3 SET DIR(0)="E"
+4 SET DIR("A")="Enter RETURN to Continue"
+5 DO ^DIR
+6 KILL DIR
+7 QUIT
End DoDot:1
SET BMCQ=1
QUIT
+8 ;
SET BARDIT=0
FOR
SET BARDIT=$ORDER(^TMP("BARDM",$JOB,BARDL,BARDIT))
IF BARDIT=""
QUIT
Begin DoDot:1
+9 ;
SET BARDI=0
FOR
SET BARDI=$ORDER(^TMP("BARDM",$JOB,BARDL,BARDIT,BARDI))
IF BARDI=""
QUIT
Begin DoDot:2
+10 IF $DATA(BARDCA)
IF BARDI'=BARDCA
QUIT
+11 IF $DATA(BARDCI)
IF BARDIT'=BARDCI
QUIT
+12 SET BARSEQ=BARSEQ+1
SET BARDITI=BARDIT_"/"_BARDI
+13 ;
WRITE !,BARSEQ,?5,BARDL,?13,$EXTRACT(BARDITI,1,42),?55,$JUSTIFY($PIECE(^TMP("BARDM",$JOB,BARDL,BARDIT,BARDI),U),7)
+14 ;
SET X=$PIECE(^TMP("BARDM",$JOB,BARDL,BARDIT,BARDI),U,3)
DO COMMA^%DTC
WRITE ?66,$JUSTIFY(X,12)
+15 ;
SET ^TMP("BARDM",$JOB,BARSEQ)=BARDL_U_BARDIT_U_BARDI_U_$EXTRACT(L,7)
+16 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
+17 QUIT
DET ;DETAIL
+1 SET BARDLQ=""
+2 SET BARBIL=0
FOR
SET BARBIL=$ORDER(^TMP("BARDM",$JOB,BARDL,BARDIT,BARDI,BARBIL))
IF BARBIL=""
QUIT
Begin DoDot:1
+3 SET DFN=$PIECE(^TMP("BARDM",$JOB,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,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,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,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,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,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
