ABMDRAL4 ; IHS/ASDST/DMJ - Bills Cost Report ;
;;2.6;IHS 3P BILLING SYSTEM;**3,8,9**;NOV 12, 2009
;Original;TMD;
; IHS/SD/SDR - abm*2.6*3 - HEAT12210 - fix output so $amounts display
;
PRINT ;EP for printing data
S ABM("PG")=0
W:$D(ABM("PRINT",16)) @ABM("PRINT",16) D HDB
F ABM="N","B","PD","DD","WO","OB" S ABM("T"_ABM)=0
S ABM("L")="",ABM("V")=0,ABM("TN")=0
;F S ABM("L")=$O(^TMP(ABM("SUBR"),"ST",$J,ABM("L"))) Q:ABM("L")="" D Q:$D(DUOUT) ;abm*2.6*8 HEAT49932
F S ABM("L")=$O(^TMP(ABM("SUBR"),$J,"ST",ABM("L"))) Q:ABM("L")="" D Q:$D(DUOUT) ;abm*2.6*8 HEAT49932
.S (ABM("SN"),ABM("V"))=0 F ABM="DD","B","PD","WO","OB" S ABM("S"_ABM)=0
.D WLOC:$Y<(IOSL-7)
.;F ABM("VI")=1:1 S ABM("V")=$O(^TMP(ABM("SUBR"),"ST",$J,ABM("L"),ABM("V"))) Q:'ABM("V") D Q:$D(DUOUT) ;abm*2.6*8 HEAT49932
.F ABM("VI")=1:1 S ABM("V")=$O(^TMP(ABM("SUBR"),$J,"ST",ABM("L"),ABM("V"))) Q:'ABM("V") D Q:$D(DUOUT) ;abm*2.6*8 HEAT49932
..I $Y>(IOSL-6) D HD Q:$D(DUOUT) D WLOC I 1
..E I ABM("VI")>1 W !
..D WSRT
..F ABM="DD","B","PD","WO","OB" S ABM("M"_ABM)=0
..S ABM("E")="",ABM("OE")="",ABM("CN")=0
..;F S ABM("E")=$O(^TMP(ABM("SUBR"),"ST",$J,ABM("L"),ABM("V"),ABM("E"))) Q:ABM("E")="" D G XIT:$D(DUOUT) ;abm*2.6*8 HEAT49932
..F S ABM("E")=$O(^TMP(ABM("SUBR"),$J,"ST",ABM("L"),ABM("V"),ABM("E"))) Q:ABM("E")="" D G XIT:$D(DUOUT) ;abm*2.6*8 HEAT49932
...I $Y>(IOSL-4) D HD Q:$D(DUOUT) D WLOC,WSRT
...W ! I ABM("E")'=ABM("OE") W $E(ABM("E"),1,30)
...S ABM("C")=0,ABM("AI")=0
...;F S ABM("C")=$O(^TMP(ABM("SUBR"),"ST",$J,ABM("L"),ABM("V"),ABM("E"),ABM("C"))) Q:'ABM("C") D Q:$D(DUOUT) ;abm*2.6*8 HEAT49932
...F S ABM("C")=$O(^TMP(ABM("SUBR"),$J,"ST",ABM("L"),ABM("V"),ABM("E"),ABM("C"))) Q:'ABM("C") D Q:$D(DUOUT) ;abm*2.6*8 HEAT49932
....I $Y>(IOSL-4) D HD Q:$D(DUOUT) D WLOC,WSRT
....I ABM("AI") W !
....S ABM("AI")=ABM("AI")+1
....S ABM("CN")=ABM("CN")+1
....S ABM("SN")=ABM("SN")+1
....S ABM("TN")=ABM("TN")+1
....S ABM=$P(^ABMDBILL(DUZ(2),ABM("C"),0),U,5)
....W ?32,$S($D(^AUPNPAT(ABM,41,ABM("L"),0)):$P(^(0),U,2),$D(^AUPNPAT(ABM,41,DUZ(2),0)):$P(^(0),U,2),1:"")
....;W:$G(^ABMDBILL(DUZ(2),ABM("C"),7)) ?40,$E(+^(7),4,5),"/",$E(+^(7),6,7)
....W ?40,$J($P(^ABMDBILL(DUZ(2),ABM("C"),0),U),7)
....S ABM("I")=0
....F ABM="48^N","51^B","65^PD","79^DD","93^WO","107^OB" D Q:$D(DUOUT)
.....S ABM("I")=ABM("I")+1 Q:+ABM=48
.....;S ABM("P")=$P(^TMP(ABM("SUBR"),"ST",$J,ABM("L"),ABM("V"),ABM("E"),ABM("C")),U,ABM("I")) ;abm*2.6*3 HEAT12210
.....S ABM("P")=$P(^TMP(ABM("SUBR"),$J,"ST",ABM("L"),ABM("V"),ABM("E"),ABM("C")),U,ABM("I")) ;abm*2.6*3 HEAT12210
.....S ABM($P(ABM,U,2))=ABM("P")
.....S ABM("T"_$P(ABM,U,2))=ABM("P")+ABM("T"_$P(ABM,U,2))
.....S ABM("S"_$P(ABM,U,2))=ABM("P")+ABM("S"_$P(ABM,U,2))
.....S ABM("M"_$P(ABM,U,2))=ABM("P")+ABM("M"_$P(ABM,U,2))
.....I +ABM=58 W ?58,$J($FN(ABM("P"),",",0),5)
.....E W ?+ABM,$J($FN(ABM("P"),",",2),12)
....W ?124,$J($J($S(ABM("B"):(ABM("PD")/ABM("B")*100),1:0),".",1),5)
..Q:ABM("CN")=1
..W !?40,"-------" F ABM=51,65,79,93,107 W ?ABM," ----------"
..W ?123,"------",!?27,"Subtotal:",?40,$J($FN(ABM("CN"),",",0),7)
..F ABM="51^B","65^PD","79^DD","93^WO","107^OB" W ?+ABM,$J($FN(ABM("M"_$P(ABM,U,2)),",",2),12)
..W ?124,$J($J($S(ABM("MB"):(ABM("MPD")/ABM("MB")*100),1:0),".",1),5)
.W !?40,"-------" F ABM=51,65,79,93,107 W ?ABM," ----------"
.W ?123,"------",!?30,"Total:",?40,$J($FN(ABM("SN"),",",0),7)
.F ABM="51^B","65^PD","79^DD","93^WO","107^OB" W ?+ABM,$J($FN(ABM("S"_$P(ABM,U,2)),",",2),12)
.W ?124,$J($J($S(ABM("SB"):(ABM("SPD")/ABM("SB")*100),1:0),".",1),5)
I ABM("TN")'=+$G(ABM("SN")) D
.W !?40,"=======" F ABM=51,65,79,93,107 W ?ABM," ==========="
.W ?123,"======",!?24,"Grand Total:",?40,$J($FN(ABM("TN"),",",0),7)
.F ABM="51^B","65^PD","79^DD","93^WO","107^OB" W ?+ABM,$J($FN(ABM("T"_$P(ABM,U,2)),",",2),12)
.W ?124,$J($J($S(ABM("TB"):(ABM("TPD")/ABM("TB")*100),1:0),".",1),5)
G XIT
;
HD D PAZ^ABMDRUTL I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) S DUOUT="" Q
HDB S ABM("PG")=ABM("PG")+1 D WHD^ABMDRHD
W !?41,"Bill",?55,"Amount",?69,"Amount",?81,"Deductible",?95,"Write Off-",?110,"Residual",?121,"Collection"
W !?10,"Insurer",?33,"HRN",?40,"Number",?55,"Billed",?70,"Paid",?81,"and Co-Ins",?95,"Adjustment",?110,"Balance",?121,"Percentage"
S $P(ABM("LINE"),"-",132)="" W !,ABM("LINE") K ABM("LINE")
Q
;
WLOC W !!?3,"Visit Location: ",ABM("L")
Q
;
WSRT I ABMY("SORT")="V" W !?7,"Visit Type: ",$E($P(^ABMDVTYP(ABM("V"),0),U),1,18)
I ABMY("SORT")="C" W !?11,"Clinic: ",$E($P(^DIC(40.7,ABM("V"),0),U),1,18)
Q
;
XIT K ^TMP(ABM("SUBR"),"ST",$J)
Q
ABMDRAL4 ; IHS/ASDST/DMJ - Bills Cost Report ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**3,8,9**;NOV 12, 2009
+2 ;Original;TMD;
+3 ; IHS/SD/SDR - abm*2.6*3 - HEAT12210 - fix output so $amounts display
+4 ;
PRINT ;EP for printing data
+1 SET ABM("PG")=0
+2 IF $DATA(ABM("PRINT",16))
WRITE @ABM("PRINT",16)
DO HDB
+3 FOR ABM="N","B","PD","DD","WO","OB"
SET ABM("T"_ABM)=0
+4 SET ABM("L")=""
SET ABM("V")=0
SET ABM("TN")=0
+5 ;F S ABM("L")=$O(^TMP(ABM("SUBR"),"ST",$J,ABM("L"))) Q:ABM("L")="" D Q:$D(DUOUT) ;abm*2.6*8 HEAT49932
+6 ;abm*2.6*8 HEAT49932
FOR
SET ABM("L")=$ORDER(^TMP(ABM("SUBR"),$JOB,"ST",ABM("L")))
IF ABM("L")=""
QUIT
Begin DoDot:1
+7 SET (ABM("SN"),ABM("V"))=0
FOR ABM="DD","B","PD","WO","OB"
SET ABM("S"_ABM)=0
+8 IF $Y<(IOSL-7)
DO WLOC
+9 ;F ABM("VI")=1:1 S ABM("V")=$O(^TMP(ABM("SUBR"),"ST",$J,ABM("L"),ABM("V"))) Q:'ABM("V") D Q:$D(DUOUT) ;abm*2.6*8 HEAT49932
+10 ;abm*2.6*8 HEAT49932
FOR ABM("VI")=1:1
SET ABM("V")=$ORDER(^TMP(ABM("SUBR"),$JOB,"ST",ABM("L"),ABM("V")))
IF 'ABM("V")
QUIT
Begin DoDot:2
+11 IF $Y>(IOSL-6)
DO HD
IF $DATA(DUOUT)
QUIT
DO WLOC
IF 1
+12 IF '$TEST
IF ABM("VI")>1
WRITE !
+13 DO WSRT
+14 FOR ABM="DD","B","PD","WO","OB"
SET ABM("M"_ABM)=0
+15 SET ABM("E")=""
SET ABM("OE")=""
SET ABM("CN")=0
+16 ;F S ABM("E")=$O(^TMP(ABM("SUBR"),"ST",$J,ABM("L"),ABM("V"),ABM("E"))) Q:ABM("E")="" D G XIT:$D(DUOUT) ;abm*2.6*8 HEAT49932
+17 ;abm*2.6*8 HEAT49932
FOR
SET ABM("E")=$ORDER(^TMP(ABM("SUBR"),$JOB,"ST",ABM("L"),ABM("V"),ABM("E")))
IF ABM("E")=""
QUIT
Begin DoDot:3
+18 IF $Y>(IOSL-4)
DO HD
IF $DATA(DUOUT)
QUIT
DO WLOC
DO WSRT
+19 WRITE !
IF ABM("E")'=ABM("OE")
WRITE $EXTRACT(ABM("E"),1,30)
+20 SET ABM("C")=0
SET ABM("AI")=0
+21 ;F S ABM("C")=$O(^TMP(ABM("SUBR"),"ST",$J,ABM("L"),ABM("V"),ABM("E"),ABM("C"))) Q:'ABM("C") D Q:$D(DUOUT) ;abm*2.6*8 HEAT49932
+22 ;abm*2.6*8 HEAT49932
FOR
SET ABM("C")=$ORDER(^TMP(ABM("SUBR"),$JOB,"ST",ABM("L"),ABM("V"),ABM("E"),ABM("C")))
IF 'ABM("C")
QUIT
Begin DoDot:4
+23 IF $Y>(IOSL-4)
DO HD
IF $DATA(DUOUT)
QUIT
DO WLOC
DO WSRT
+24 IF ABM("AI")
WRITE !
+25 SET ABM("AI")=ABM("AI")+1
+26 SET ABM("CN")=ABM("CN")+1
+27 SET ABM("SN")=ABM("SN")+1
+28 SET ABM("TN")=ABM("TN")+1
+29 SET ABM=$PIECE(^ABMDBILL(DUZ(2),ABM("C"),0),U,5)
+30 WRITE ?32,$SELECT($DATA(^AUPNPAT(ABM,41,ABM("L"),0)):$PIECE(^(0),U,2),$DATA(^AUPNPAT(ABM,41,DUZ(2),0)):$PIECE(^(0),U,2),1:"")
+31 ;W:$G(^ABMDBILL(DUZ(2),ABM("C"),7)) ?40,$E(+^(7),4,5),"/",$E(+^(7),6,7)
+32 WRITE ?40,$JUSTIFY($PIECE(^ABMDBILL(DUZ(2),ABM("C"),0),U),7)
+33 SET ABM("I")=0
+34 FOR ABM="48^N","51^B","65^PD","79^DD","93^WO","107^OB"
Begin DoDot:5
+35 SET ABM("I")=ABM("I")+1
IF +ABM=48
QUIT
+36 ;S ABM("P")=$P(^TMP(ABM("SUBR"),"ST",$J,ABM("L"),ABM("V"),ABM("E"),ABM("C")),U,ABM("I")) ;abm*2.6*3 HEAT12210
+37 ;abm*2.6*3 HEAT12210
SET ABM("P")=$PIECE(^TMP(ABM("SUBR"),$JOB,"ST",ABM("L"),ABM("V"),ABM("E"),ABM("C")),U,ABM("I"))
+38 SET ABM($PIECE(ABM,U,2))=ABM("P")
+39 SET ABM("T"_$PIECE(ABM,U,2))=ABM("P")+ABM("T"_$PIECE(ABM,U,2))
+40 SET ABM("S"_$PIECE(ABM,U,2))=ABM("P")+ABM("S"_$PIECE(ABM,U,2))
+41 SET ABM("M"_$PIECE(ABM,U,2))=ABM("P")+ABM("M"_$PIECE(ABM,U,2))
+42 IF +ABM=58
WRITE ?58,$JUSTIFY($FNUMBER(ABM("P"),",",0),5)
+43 IF '$TEST
WRITE ?+ABM,$JUSTIFY($FNUMBER(ABM("P"),",",2),12)
End DoDot:5
IF $DATA(DUOUT)
QUIT
+44 WRITE ?124,$JUSTIFY($JUSTIFY($SELECT(ABM("B"):(ABM("PD")/ABM("B")*100),1:0),".",1),5)
End DoDot:4
IF $DATA(DUOUT)
QUIT
End DoDot:3
IF $DATA(DUOUT)
GOTO XIT
+45 IF ABM("CN")=1
QUIT
+46 WRITE !?40,"-------"
FOR ABM=51,65,79,93,107
WRITE ?ABM," ----------"
+47 WRITE ?123,"------",!?27,"Subtotal:",?40,$JUSTIFY($FNUMBER(ABM("CN"),",",0),7)
+48 FOR ABM="51^B","65^PD","79^DD","93^WO","107^OB"
WRITE ?+ABM,$JUSTIFY($FNUMBER(ABM("M"_$PIECE(ABM,U,2)),",",2),12)
+49 WRITE ?124,$JUSTIFY($JUSTIFY($SELECT(ABM("MB"):(ABM("MPD")/ABM("MB")*100),1:0),".",1),5)
End DoDot:2
IF $DATA(DUOUT)
QUIT
+50 WRITE !?40,"-------"
FOR ABM=51,65,79,93,107
WRITE ?ABM," ----------"
+51 WRITE ?123,"------",!?30,"Total:",?40,$JUSTIFY($FNUMBER(ABM("SN"),",",0),7)
+52 FOR ABM="51^B","65^PD","79^DD","93^WO","107^OB"
WRITE ?+ABM,$JUSTIFY($FNUMBER(ABM("S"_$PIECE(ABM,U,2)),",",2),12)
+53 WRITE ?124,$JUSTIFY($JUSTIFY($SELECT(ABM("SB"):(ABM("SPD")/ABM("SB")*100),1:0),".",1),5)
End DoDot:1
IF $DATA(DUOUT)
QUIT
+54 IF ABM("TN")'=+$GET(ABM("SN"))
Begin DoDot:1
+55 WRITE !?40,"======="
FOR ABM=51,65,79,93,107
WRITE ?ABM," ==========="
+56 WRITE ?123,"======",!?24,"Grand Total:",?40,$JUSTIFY($FNUMBER(ABM("TN"),",",0),7)
+57 FOR ABM="51^B","65^PD","79^DD","93^WO","107^OB"
WRITE ?+ABM,$JUSTIFY($FNUMBER(ABM("T"_$PIECE(ABM,U,2)),",",2),12)
+58 WRITE ?124,$JUSTIFY($JUSTIFY($SELECT(ABM("TB"):(ABM("TPD")/ABM("TB")*100),1:0),".",1),5)
End DoDot:1
+59 GOTO XIT
+60 ;
HD DO PAZ^ABMDRUTL
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
SET DUOUT=""
QUIT
HDB SET ABM("PG")=ABM("PG")+1
DO WHD^ABMDRHD
+1 WRITE !?41,"Bill",?55,"Amount",?69,"Amount",?81,"Deductible",?95,"Write Off-",?110,"Residual",?121,"Collection"
+2 WRITE !?10,"Insurer",?33,"HRN",?40,"Number",?55,"Billed",?70,"Paid",?81,"and Co-Ins",?95,"Adjustment",?110,"Balance",?121,"Percentage"
+3 SET $PIECE(ABM("LINE"),"-",132)=""
WRITE !,ABM("LINE")
KILL ABM("LINE")
+4 QUIT
+5 ;
WLOC WRITE !!?3,"Visit Location: ",ABM("L")
+1 QUIT
+2 ;
WSRT IF ABMY("SORT")="V"
WRITE !?7,"Visit Type: ",$EXTRACT($PIECE(^ABMDVTYP(ABM("V"),0),U),1,18)
+1 IF ABMY("SORT")="C"
WRITE !?11,"Clinic: ",$EXTRACT($PIECE(^DIC(40.7,ABM("V"),0),U),1,18)
+2 QUIT
+3 ;
XIT KILL ^TMP(ABM("SUBR"),"ST",$JOB)
+1 QUIT
