RCRJRBDR ;WISC/RFJ,TJK-bad debt report generator ;1 Feb 98
;;4.5;Accounts Receivable;**101,139,170,191,203,215,220,138,239,310**;Mar 20, 1995;Build 14
;;Per VA Directive 6402, this routine should not be modified.
Q
;
;
PRINT ; print report on printer, called from menu option
N RCRJDATE
W !!,"This option will print the Bad Debt Report. The Bad Debt allowance"
W !,"estimates are computed by the AR Data Collector at the end of the"
W !,"accounting month, and sent to FMS at that time. The allowance"
W !,"estimate is no longer editable prior to transmission to FMS.",!
N %ZIS,POP,ZTRTN,ZTDESC S %ZIS="QM" D ^%ZIS Q:POP
I $D(IO("Q")) D Q
. S ZTRTN="DQ^RCRJRBDR",ZTDESC="Bad Debt Report"
. D ^%ZTLOAD
;
W !,"please wait"
D DQ
Q
;
;
DQ ; generate the report
; rcrjfmm = flag to put in mail message (if $g(rcrjfmm)) (optional)
; rcrjdate = date month and year for report (optional)
; rcrjfxsv = fms document id number if sent to fms (optional)
; (newed and set by rcxfmssv, label Q)
;
N %,%I,CHANGED,DATA,DATA1319,DATA1338,DATA1339,DATALTC,DATEREPT,ENDDATE,X
N LINE,RCRJFLAG,SCREEN,SPACE,Y,DATA133N
;
K ^TMP($J,"RCRJRCORMM")
S SPACE="",$P(SPACE," ",81)=""
; the date of the report is for previous month if the DT is before the EOAM date of the current month, it is for the current month if the date is after the EOAM cut-off date.
I $G(RCRJDATE) S RCRJDATE=$E($$LDATE^RCRJR(RCRJDATE),1,5)_"00"
I '$G(RCRJDATE) D
.I $E(DT,6,7)'>$E($$LDATE^RCRJR(DT),6,7) S RCRJDATE=$$PREVMONT^RCRJRBD(DT)
.I $E(DT,6,7)>$E($$LDATE^RCRJR(DT),6,7) S RCRJDATE=$E($$LDATE^RCRJR(DT),1,5)_"00"
S Y=$E(RCRJDATE,1,5)_"00" D DD^%DT S DATEREPT=Y
S LINE=0
;
; jump to RCRJRBDT to generate the new Bad Debt Report,
; in order to save the code for the older report.
D BDR^RCRJRBDT G MAIL
;
D SETLINE(" ")
D SETLINE($E(SPACE,1,32)_"Bad Debt Report")
D SETLINE($E(SPACE,1,13)_"Allowance for Bad Debt and Contract Adjustment Report")
D SETLINE($E(SPACE,1,27)_"for the month of "_DATEREPT)
I $D(RCRJFXSV) D
. D SETLINE(" ")
. I $E(RCRJFXSV,1,2)="SV" D SETLINE($E(SPACE,1,13)_"***** Report sent to FMS, doc id: "_RCRJFXSV_" *****") Q
. ; report errored out or did not get generated to fms
. D SETLINE($E(SPACE,1,10)_"***** NOTICE: Report was NOT sent to FMS, the message is *****")
. D SETLINE($E(SPACE,1,10)_"***** "_RCRJFXSV_" *****")
;
; show mccf
; Add 528713 PRCA*4.5*310/DRF
D SETLINE(" ")
D SETLINE($E(SPACE,1,26)_"Medical Care Collection Fund")
I $E($G(RCRJDATE),2,5)'<"0410" D SETLINE($E(SPACE,1,26)_" Funds 528701, 528703, 528704 & 528713")
I $E($G(RCRJDATE),2,5)<"0410" D SETLINE($E(SPACE,1,26)_" Funds 5287.1, 5287.3, & 5287.4")
D SETLINE($E(SPACE,1,26)_"----------------------------")
D SETLINE(" ")
D SETLINE("Calculated "_$J(" ",14)_$J(" Third Party",14)_$J(" Third Party",14))
D SETLINE("Percentages "_$J(" First Party",14)_$J(" Cont Adj",14)_$J(" Cont Adj",14)_$J("Tort Feasors",14))
D SETLINE("For "_$J(" SGL 1319",14)_$J(" SGL 1339",14)_$J(" SGL 133N",14)_$J(" SGL 1338",14))
D SETLINE("---------------------"_$J("------------",14)_$J("------------",14)_$J("------------",14)_$J("------------",14))
S DATA1319=$G(^RC(348.1,+$O(^RC(348.1,"B",1319,0)),0))
S DATA1338=$G(^RC(348.1,+$O(^RC(348.1,"B",1338,0)),0))
S DATA1339=$G(^RC(348.1,+$O(^RC(348.1,"B",1339,0)),0))
S DATA133N=$G(^RC(348.1,+$O(^RC(348.1,"B","133N",0)),0))
D SETLINE("Collection %"_$J($P(DATA1319,"^",2),14,2)_$J($P(DATA1339,"^",2),14,2)_$J($P(DATA133N,"^",2),14,2)_$J($P(DATA1338,"^",2),14,2))
D SETLINE("Write-Off %"_$J($P(DATA1319,"^",3),14,2)_$J($P(DATA1339,"^",3),14,2)_$J($P(DATA133N,"^",3),14,2)_$J($P(DATA1338,"^",3),14,2))
D SETLINE("Contract Adjustment %"_$J($P(DATA1319,"^",4),14,2)_$J($P(DATA1339,"^",4),14,2)_$J($P(DATA133N,"^",4),14,2)_$J($P(DATA1338,"^",4),14,2))
D SETLINE("---------------------"_$J("------------",14)_$J("------------",14)_$J("------------",14)_$J("------------",14))
D SETLINE("TOTAL %"_$J(100,14,2)_$J(100,14,2)_$J(100,14,2)_$J(100,14,2))
D SETLINE(" ")
;
S DATALTC=$G(^RC(348.1,+$O(^RC(348.1,"B",1319.2,0)),0))
I $E($G(RCRJDATE),2,5)'<"0410" D SETLINE($E(SPACE,1,26)_" Extended (LTC) Care Fund 528709")
I $E($G(RCRJDATE),2,5)<"0410" D SETLINE($E(SPACE,1,26)_" Extended (LTC) Care Fund 4032")
D SETLINE($E(SPACE,1,26)_"---------------------------------")
D SETLINE(" ")
I $E($G(RCRJDATE),2,5)'<"0410" D SETLINE("Calculated "_$J(" Fund 528709",18))
I $E($G(RCRJDATE),2,5)<"0410" D SETLINE("Calculated "_$J(" Fund 4032",18))
D SETLINE("Percentages "_$J(" First Party",18))
D SETLINE("For "_$J(" SGL 1319",18))
D SETLINE("---------------------"_$J("------------",18))
D SETLINE("Collection %"_$J($P(DATALTC,"^",2),18,2))
D SETLINE("Write-Off %"_$J($P(DATALTC,"^",3),18,2))
D SETLINE("Contract Adjustment %"_$J($P(DATALTC,"^",4),18,2))
D SETLINE("---------------------"_$J("------------",18))
D SETLINE("TOTAL %"_$J(100,18,2))
D SETLINE(" ")
;
; show totals
; 1319 mccf allowance
D SETLINE("Allowance for Bad Debt - First Party (SGL 1319 MCCF):")
D SETLINE("----------------------------------------------------")
S CHANGED=" " I $P(DATA1319,"^",10) S CHANGED="**"
D SETLINE($E("Allowance Estimate for "_DATEREPT_SPACE,1,35)_":"_$J($P(DATA1319,"^",8),16,2)_" "_CHANGED_" (Normally Credit Value)")
D SETLINE($E("Bad Debt Write-Off (Plus) "_SPACE,1,35)_":"_$J($P(DATA1319,"^",9),16,2)_" (Normally Debit Value )")
D SETLINE("----------------------------------------------------")
D SETLINE($E("Transmitted Amount to FMS for Month"_SPACE,1,35)_":"_$J($P(DATA1319,"^",8)+$P(DATA1319,"^",9),16,2)_" "_CHANGED_" (Normally Credit Value)")
I $P(DATA1319,"^",10) D SETLINE($E(SPACE,1,53)_"** Changed Locally")
D SETLINE(" ")
;
; 1319 ltc allowance
D SETLINE("Allowance for Bad Debt - First Party (SGL 1319 LTC 528709):")
D SETLINE("----------------------------------------------------")
S CHANGED=" " I $P(DATALTC,"^",10) S CHANGED="**"
D SETLINE($E("Allowance Estimate for "_DATEREPT_SPACE,1,35)_":"_$J($P(DATALTC,"^",8),16,2)_" "_CHANGED_" (Normally Credit Value)")
D SETLINE($E("Bad Debt Write-Off (Plus) "_SPACE,1,35)_":"_$J($P(DATALTC,"^",9),16,2)_" (Normally Debit Value )")
D SETLINE("----------------------------------------------------")
D SETLINE($E("Transmitted Amount to FMS for Month"_SPACE,1,35)_":"_$J($P(DATALTC,"^",8)+$P(DATALTC,"^",9),16,2)_" "_CHANGED_" (Normally Credit Value)")
I $P(DATALTC,"^",10) D SETLINE($E(SPACE,1,53)_"** Changed Locally")
D SETLINE(" ")
;
; 1339 allowance
D SETLINE("Allowance for Contract Adj - Third Party (SGL 1339):")
D SETLINE("----------------------------------------------------")
S CHANGED=" " I $P(DATA1339,"^",10) S CHANGED="**"
D SETLINE($E("Allowance Estimate for "_DATEREPT_SPACE,1,35)_":"_$J($P(DATA1339,"^",8),16,2)_" "_CHANGED_" (Normally Credit Value)")
D SETLINE($E("Bad Debt Contract Adj (Plus) "_SPACE,1,35)_":"_$J($P(DATA1339,"^",9),16,2)_" (Normally Debit Value )")
D SETLINE("----------------------------------------------------")
D SETLINE($E("Transmitted Amount to FMS for Month"_SPACE,1,35)_":"_$J($P(DATA1339,"^",8)+$P(DATA1339,"^",9),16,2)_" "_CHANGED_" (Normally Credit Value)")
I $P(DATA1339,"^",10) D SETLINE($E(SPACE,1,53)_"** Changed Locally")
D SETLINE(" ")
;
; 133N allowance - Post-MRA non-Medicare
D SETLINE("Allowance for Contract Adj - Third Party (SGL 133N):")
D SETLINE("----------------------------------------------------")
S CHANGED=" " I $P(DATA133N,"^",10) S CHANGED="**"
D SETLINE($E("Allowance Estimate for "_DATEREPT_SPACE,1,35)_":"_$J($P(DATA133N,"^",8),16,2)_" "_CHANGED_" (Normally Credit Value)")
D SETLINE($E("Bad Debt Contract Adj (Plus) "_SPACE,1,35)_":"_$J($P(DATA133N,"^",9),16,2)_" (Normally Debit Value )")
D SETLINE("----------------------------------------------------")
D SETLINE($E("Transmitted Amount to FMS for Month"_SPACE,1,35)_":"_$J($P(DATA133N,"^",8)+$P(DATA133N,"^",9),16,2)_" "_CHANGED_" (Normally Credit Value)")
I $P(DATA133N,"^",10) D SETLINE($E(SPACE,1,53)_"** Changed Locally")
D SETLINE(" ")
;
; 1338 allowance
D SETLINE("Allowance for Bad Debt - Tort Feasors (SGL 1338):")
D SETLINE("----------------------------------------------------")
S CHANGED=" " I $P(DATA1338,"^",10) S CHANGED="**"
D SETLINE($E("Allowance Estimate for "_DATEREPT_SPACE,1,35)_":"_$J($P(DATA1338,"^",8),16,2)_" "_CHANGED_" (Normally Credit Value)")
D SETLINE($E("Bad Debt Write-Off (Plus) "_SPACE,1,35)_":"_$J($P(DATA1338,"^",9),16,2)_" (Normally Debit Value )")
D SETLINE("----------------------------------------------------")
D SETLINE($E("Transmitted Amount to FMS for Month"_SPACE,1,35)_":"_$J($P(DATA1338,"^",8)+$P(DATA1338,"^",9),16,2)_" "_CHANGED_" (Normally Credit Value)")
I $P(DATA1338,"^",10) D SETLINE($E(SPACE,1,53)_"** Changed Locally")
D SETLINE(" ")
D SETLINE("Report Footnotes:")
D SETLINE("-----------------")
;
D ENDOFREP^RCRJRBDT
;
MAIL ; put report in mailman
I $G(RCRJFMM) D D Q Q
. N XMY
. S XMY("G.RC AR DATA COLLECTOR")=""
. S %=$$SENDMSG^RCRJRCOR("BAD DEBT REPORT",.XMY)
;
; print report
S SCREEN=0 I '$D(ZTQUEUED),IO=IO(0),$E(IOST)="C" S SCREEN=1
U IO I SCREEN W @IOF
S LINE=1 F S LINE=$O(^TMP($J,"RCRJRCORMM",LINE)) Q:'LINE!($G(RCRJFLAG)) D
. I $Y>(IOSL-5) D:SCREEN PAUSE^RCRJRTR1 Q:$G(RCRJFLAG) W @IOF F %=2:1:5 W !,^TMP($J,"RCRJRCORMM",%)
. W !,^TMP($J,"RCRJRCORMM",LINE)
I '$G(RCRJFLAG),SCREEN R !!,"<end of report, press return to continue>",X:DTIME
D ^%ZISC
;
Q K ^TMP($J,"RCRJRCORMM")
Q
;
;
SETLINE(DATA) ; build the line for the report
S LINE=LINE+1,^TMP($J,"RCRJRCORMM",LINE)=DATA
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCRJRBDR 9988 printed Sep 23, 2025@19:24:14 Page 2
RCRJRBDR ;WISC/RFJ,TJK-bad debt report generator ;1 Feb 98
+1 ;;4.5;Accounts Receivable;**101,139,170,191,203,215,220,138,239,310**;Mar 20, 1995;Build 14
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
PRINT ; print report on printer, called from menu option
+1 NEW RCRJDATE
+2 WRITE !!,"This option will print the Bad Debt Report. The Bad Debt allowance"
+3 WRITE !,"estimates are computed by the AR Data Collector at the end of the"
+4 WRITE !,"accounting month, and sent to FMS at that time. The allowance"
+5 WRITE !,"estimate is no longer editable prior to transmission to FMS.",!
+6 NEW %ZIS,POP,ZTRTN,ZTDESC
SET %ZIS="QM"
DO ^%ZIS
if POP
QUIT
+7 IF $DATA(IO("Q"))
Begin DoDot:1
+8 SET ZTRTN="DQ^RCRJRBDR"
SET ZTDESC="Bad Debt Report"
+9 DO ^%ZTLOAD
End DoDot:1
QUIT
+10 ;
+11 WRITE !,"please wait"
+12 DO DQ
+13 QUIT
+14 ;
+15 ;
DQ ; generate the report
+1 ; rcrjfmm = flag to put in mail message (if $g(rcrjfmm)) (optional)
+2 ; rcrjdate = date month and year for report (optional)
+3 ; rcrjfxsv = fms document id number if sent to fms (optional)
+4 ; (newed and set by rcxfmssv, label Q)
+5 ;
+6 NEW %,%I,CHANGED,DATA,DATA1319,DATA1338,DATA1339,DATALTC,DATEREPT,ENDDATE,X
+7 NEW LINE,RCRJFLAG,SCREEN,SPACE,Y,DATA133N
+8 ;
+9 KILL ^TMP($JOB,"RCRJRCORMM")
+10 SET SPACE=""
SET $PIECE(SPACE," ",81)=""
+11 ; the date of the report is for previous month if the DT is before the EOAM date of the current month, it is for the current month if the date is after the EOAM cut-off date.
+12 IF $GET(RCRJDATE)
SET RCRJDATE=$EXTRACT($$LDATE^RCRJR(RCRJDATE),1,5)_"00"
+13 IF '$GET(RCRJDATE)
Begin DoDot:1
+14 IF $EXTRACT(DT,6,7)'>$EXTRACT($$LDATE^RCRJR(DT),6,7)
SET RCRJDATE=$$PREVMONT^RCRJRBD(DT)
+15 IF $EXTRACT(DT,6,7)>$EXTRACT($$LDATE^RCRJR(DT),6,7)
SET RCRJDATE=$EXTRACT($$LDATE^RCRJR(DT),1,5)_"00"
End DoDot:1
+16 SET Y=$EXTRACT(RCRJDATE,1,5)_"00"
DO DD^%DT
SET DATEREPT=Y
+17 SET LINE=0
+18 ;
+19 ; jump to RCRJRBDT to generate the new Bad Debt Report,
+20 ; in order to save the code for the older report.
+21 DO BDR^RCRJRBDT
GOTO MAIL
+22 ;
+23 DO SETLINE(" ")
+24 DO SETLINE($EXTRACT(SPACE,1,32)_"Bad Debt Report")
+25 DO SETLINE($EXTRACT(SPACE,1,13)_"Allowance for Bad Debt and Contract Adjustment Report")
+26 DO SETLINE($EXTRACT(SPACE,1,27)_"for the month of "_DATEREPT)
+27 IF $DATA(RCRJFXSV)
Begin DoDot:1
+28 DO SETLINE(" ")
+29 IF $EXTRACT(RCRJFXSV,1,2)="SV"
DO SETLINE($EXTRACT(SPACE,1,13)_"***** Report sent to FMS, doc id: "_RCRJFXSV_" *****")
QUIT
+30 ; report errored out or did not get generated to fms
+31 DO SETLINE($EXTRACT(SPACE,1,10)_"***** NOTICE: Report was NOT sent to FMS, the message is *****")
+32 DO SETLINE($EXTRACT(SPACE,1,10)_"***** "_RCRJFXSV_" *****")
End DoDot:1
+33 ;
+34 ; show mccf
+35 ; Add 528713 PRCA*4.5*310/DRF
+36 DO SETLINE(" ")
+37 DO SETLINE($EXTRACT(SPACE,1,26)_"Medical Care Collection Fund")
+38 IF $EXTRACT($GET(RCRJDATE),2,5)'<"0410"
DO SETLINE($EXTRACT(SPACE,1,26)_" Funds 528701, 528703, 528704 & 528713")
+39 IF $EXTRACT($GET(RCRJDATE),2,5)<"0410"
DO SETLINE($EXTRACT(SPACE,1,26)_" Funds 5287.1, 5287.3, & 5287.4")
+40 DO SETLINE($EXTRACT(SPACE,1,26)_"----------------------------")
+41 DO SETLINE(" ")
+42 DO SETLINE("Calculated "_$JUSTIFY(" ",14)_$JUSTIFY(" Third Party",14)_$JUSTIFY(" Third Party",14))
+43 DO SETLINE("Percentages "_$JUSTIFY(" First Party",14)_$JUSTIFY(" Cont Adj",14)_$JUSTIFY(" Cont Adj",14)_$JUSTIFY("Tort Feasors",14))
+44 DO SETLINE("For "_$JUSTIFY(" SGL 1319",14)_$JUSTIFY(" SGL 1339",14)_$JUSTIFY(" SGL 133N",14)_$JUSTIFY(" SGL 1338",14))
+45 DO SETLINE("---------------------"_$JUSTIFY("------------",14)_$JUSTIFY("------------",14)_$JUSTIFY("------------",14)_$JUSTIFY("------------",14))
+46 SET DATA1319=$GET(^RC(348.1,+$ORDER(^RC(348.1,"B",1319,0)),0))
+47 SET DATA1338=$GET(^RC(348.1,+$ORDER(^RC(348.1,"B",1338,0)),0))
+48 SET DATA1339=$GET(^RC(348.1,+$ORDER(^RC(348.1,"B",1339,0)),0))
+49 SET DATA133N=$GET(^RC(348.1,+$ORDER(^RC(348.1,"B","133N",0)),0))
+50 DO SETLINE("Collection %"_$JUSTIFY($PIECE(DATA1319,"^",2),14,2)_$JUSTIFY($PIECE(DATA1339,"^",2),14,2)_$JUSTIFY($PIECE(DATA133N,"^",2),14,2)_$JUSTIFY($PIECE(DATA1338,"^",2),14,2))
+51 DO SETLINE("Write-Off %"_$JUSTIFY($PIECE(DATA1319,"^",3),14,2)_$JUSTIFY($PIECE(DATA1339,"^",3),14,2)_$JUSTIFY($PIECE(DATA133N,"^",3),14,2)_$JUSTIFY($PIECE(DATA1338,"^",3),14,2))
+52 DO SETLINE("Contract Adjustment %"_$JUSTIFY($PIECE(DATA1319,"^",4),14,2)_$JUSTIFY($PIECE(DATA1339,"^",4),14,2)_$JUSTIFY($PIECE(DATA133N,"^",4),14,2)_$JUSTIFY($PIECE(DATA1338,"^",4),14,2))
+53 DO SETLINE("---------------------"_$JUSTIFY("------------",14)_$JUSTIFY("------------",14)_$JUSTIFY("------------",14)_$JUSTIFY("------------",14))
+54 DO SETLINE("TOTAL %"_$JUSTIFY(100,14,2)_$JUSTIFY(100,14,2)_$JUSTIFY(100,14,2)_$JUSTIFY(100,14,2))
+55 DO SETLINE(" ")
+56 ;
+57 SET DATALTC=$GET(^RC(348.1,+$ORDER(^RC(348.1,"B",1319.2,0)),0))
+58 IF $EXTRACT($GET(RCRJDATE),2,5)'<"0410"
DO SETLINE($EXTRACT(SPACE,1,26)_" Extended (LTC) Care Fund 528709")
+59 IF $EXTRACT($GET(RCRJDATE),2,5)<"0410"
DO SETLINE($EXTRACT(SPACE,1,26)_" Extended (LTC) Care Fund 4032")
+60 DO SETLINE($EXTRACT(SPACE,1,26)_"---------------------------------")
+61 DO SETLINE(" ")
+62 IF $EXTRACT($GET(RCRJDATE),2,5)'<"0410"
DO SETLINE("Calculated "_$JUSTIFY(" Fund 528709",18))
+63 IF $EXTRACT($GET(RCRJDATE),2,5)<"0410"
DO SETLINE("Calculated "_$JUSTIFY(" Fund 4032",18))
+64 DO SETLINE("Percentages "_$JUSTIFY(" First Party",18))
+65 DO SETLINE("For "_$JUSTIFY(" SGL 1319",18))
+66 DO SETLINE("---------------------"_$JUSTIFY("------------",18))
+67 DO SETLINE("Collection %"_$JUSTIFY($PIECE(DATALTC,"^",2),18,2))
+68 DO SETLINE("Write-Off %"_$JUSTIFY($PIECE(DATALTC,"^",3),18,2))
+69 DO SETLINE("Contract Adjustment %"_$JUSTIFY($PIECE(DATALTC,"^",4),18,2))
+70 DO SETLINE("---------------------"_$JUSTIFY("------------",18))
+71 DO SETLINE("TOTAL %"_$JUSTIFY(100,18,2))
+72 DO SETLINE(" ")
+73 ;
+74 ; show totals
+75 ; 1319 mccf allowance
+76 DO SETLINE("Allowance for Bad Debt - First Party (SGL 1319 MCCF):")
+77 DO SETLINE("----------------------------------------------------")
+78 SET CHANGED=" "
IF $PIECE(DATA1319,"^",10)
SET CHANGED="**"
+79 DO SETLINE($EXTRACT("Allowance Estimate for "_DATEREPT_SPACE,1,35)_":"_$JUSTIFY($PIECE(DATA1319,"^",8),16,2)_" "_CHANGED_" (Normally Credit Value)")
+80 DO SETLINE($EXTRACT("Bad Debt Write-Off (Plus) "_SPACE,1,35)_":"_$JUSTIFY($PIECE(DATA1319,"^",9),16,2)_" (Normally Debit Value )")
+81 DO SETLINE("----------------------------------------------------")
+82 DO SETLINE($EXTRACT("Transmitted Amount to FMS for Month"_SPACE,1,35)_":"_$JUSTIFY($PIECE(DATA1319,"^",8)+$PIECE(DATA1319,"^",9),16,2)_" "_CHANGED_" (Normally Credit Value)")
+83 IF $PIECE(DATA1319,"^",10)
DO SETLINE($EXTRACT(SPACE,1,53)_"** Changed Locally")
+84 DO SETLINE(" ")
+85 ;
+86 ; 1319 ltc allowance
+87 DO SETLINE("Allowance for Bad Debt - First Party (SGL 1319 LTC 528709):")
+88 DO SETLINE("----------------------------------------------------")
+89 SET CHANGED=" "
IF $PIECE(DATALTC,"^",10)
SET CHANGED="**"
+90 DO SETLINE($EXTRACT("Allowance Estimate for "_DATEREPT_SPACE,1,35)_":"_$JUSTIFY($PIECE(DATALTC,"^",8),16,2)_" "_CHANGED_" (Normally Credit Value)")
+91 DO SETLINE($EXTRACT("Bad Debt Write-Off (Plus) "_SPACE,1,35)_":"_$JUSTIFY($PIECE(DATALTC,"^",9),16,2)_" (Normally Debit Value )")
+92 DO SETLINE("----------------------------------------------------")
+93 DO SETLINE($EXTRACT("Transmitted Amount to FMS for Month"_SPACE,1,35)_":"_$JUSTIFY($PIECE(DATALTC,"^",8)+$PIECE(DATALTC,"^",9),16,2)_" "_CHANGED_" (Normally Credit Value)")
+94 IF $PIECE(DATALTC,"^",10)
DO SETLINE($EXTRACT(SPACE,1,53)_"** Changed Locally")
+95 DO SETLINE(" ")
+96 ;
+97 ; 1339 allowance
+98 DO SETLINE("Allowance for Contract Adj - Third Party (SGL 1339):")
+99 DO SETLINE("----------------------------------------------------")
+100 SET CHANGED=" "
IF $PIECE(DATA1339,"^",10)
SET CHANGED="**"
+101 DO SETLINE($EXTRACT("Allowance Estimate for "_DATEREPT_SPACE,1,35)_":"_$JUSTIFY($PIECE(DATA1339,"^",8),16,2)_" "_CHANGED_" (Normally Credit Value)")
+102 DO SETLINE($EXTRACT("Bad Debt Contract Adj (Plus) "_SPACE,1,35)_":"_$JUSTIFY($PIECE(DATA1339,"^",9),16,2)_" (Normally Debit Value )")
+103 DO SETLINE("----------------------------------------------------")
+104 DO SETLINE($EXTRACT("Transmitted Amount to FMS for Month"_SPACE,1,35)_":"_$JUSTIFY($PIECE(DATA1339,"^",8)+$PIECE(DATA1339,"^",9),16,2)_" "_CHANGED_" (Normally Credit Value)")
+105 IF $PIECE(DATA1339,"^",10)
DO SETLINE($EXTRACT(SPACE,1,53)_"** Changed Locally")
+106 DO SETLINE(" ")
+107 ;
+108 ; 133N allowance - Post-MRA non-Medicare
+109 DO SETLINE("Allowance for Contract Adj - Third Party (SGL 133N):")
+110 DO SETLINE("----------------------------------------------------")
+111 SET CHANGED=" "
IF $PIECE(DATA133N,"^",10)
SET CHANGED="**"
+112 DO SETLINE($EXTRACT("Allowance Estimate for "_DATEREPT_SPACE,1,35)_":"_$JUSTIFY($PIECE(DATA133N,"^",8),16,2)_" "_CHANGED_" (Normally Credit Value)")
+113 DO SETLINE($EXTRACT("Bad Debt Contract Adj (Plus) "_SPACE,1,35)_":"_$JUSTIFY($PIECE(DATA133N,"^",9),16,2)_" (Normally Debit Value )")
+114 DO SETLINE("----------------------------------------------------")
+115 DO SETLINE($EXTRACT("Transmitted Amount to FMS for Month"_SPACE,1,35)_":"_$JUSTIFY($PIECE(DATA133N,"^",8)+$PIECE(DATA133N,"^",9),16,2)_" "_CHANGED_" (Normally Credit Value)")
+116 IF $PIECE(DATA133N,"^",10)
DO SETLINE($EXTRACT(SPACE,1,53)_"** Changed Locally")
+117 DO SETLINE(" ")
+118 ;
+119 ; 1338 allowance
+120 DO SETLINE("Allowance for Bad Debt - Tort Feasors (SGL 1338):")
+121 DO SETLINE("----------------------------------------------------")
+122 SET CHANGED=" "
IF $PIECE(DATA1338,"^",10)
SET CHANGED="**"
+123 DO SETLINE($EXTRACT("Allowance Estimate for "_DATEREPT_SPACE,1,35)_":"_$JUSTIFY($PIECE(DATA1338,"^",8),16,2)_" "_CHANGED_" (Normally Credit Value)")
+124 DO SETLINE($EXTRACT("Bad Debt Write-Off (Plus) "_SPACE,1,35)_":"_$JUSTIFY($PIECE(DATA1338,"^",9),16,2)_" (Normally Debit Value )")
+125 DO SETLINE("----------------------------------------------------")
+126 DO SETLINE($EXTRACT("Transmitted Amount to FMS for Month"_SPACE,1,35)_":"_$JUSTIFY($PIECE(DATA1338,"^",8)+$PIECE(DATA1338,"^",9),16,2)_" "_CHANGED_" (Normally Credit Value)")
+127 IF $PIECE(DATA1338,"^",10)
DO SETLINE($EXTRACT(SPACE,1,53)_"** Changed Locally")
+128 DO SETLINE(" ")
+129 DO SETLINE("Report Footnotes:")
+130 DO SETLINE("-----------------")
+131 ;
+132 DO ENDOFREP^RCRJRBDT
+133 ;
MAIL ; put report in mailman
+1 IF $GET(RCRJFMM)
Begin DoDot:1
+2 NEW XMY
+3 SET XMY("G.RC AR DATA COLLECTOR")=""
+4 SET %=$$SENDMSG^RCRJRCOR("BAD DEBT REPORT",.XMY)
End DoDot:1
DO Q
QUIT
+5 ;
+6 ; print report
+7 SET SCREEN=0
IF '$DATA(ZTQUEUED)
IF IO=IO(0)
IF $EXTRACT(IOST)="C"
SET SCREEN=1
+8 USE IO
IF SCREEN
WRITE @IOF
+9 SET LINE=1
FOR
SET LINE=$ORDER(^TMP($JOB,"RCRJRCORMM",LINE))
if 'LINE!($GET(RCRJFLAG))
QUIT
Begin DoDot:1
+10 IF $Y>(IOSL-5)
if SCREEN
DO PAUSE^RCRJRTR1
if $GET(RCRJFLAG)
QUIT
WRITE @IOF
FOR %=2:1:5
WRITE !,^TMP($JOB,"RCRJRCORMM",%)
+11 WRITE !,^TMP($JOB,"RCRJRCORMM",LINE)
End DoDot:1
+12 IF '$GET(RCRJFLAG)
IF SCREEN
READ !!,"<end of report, press return to continue>",X:DTIME
+13 DO ^%ZISC
+14 ;
Q KILL ^TMP($JOB,"RCRJRCORMM")
+1 QUIT
+2 ;
+3 ;
SETLINE(DATA) ; build the line for the report
+1 SET LINE=LINE+1
SET ^TMP($JOB,"RCRJRCORMM",LINE)=DATA
+2 QUIT
