ABMDRAL3 ; IHS/ASDST/DMJ - Bills Stats Report ;
;;2.6;IHS 3P BILLING SYSTEM;**4,9**;NOV 12, 2009
;Original;TMD;
; IHS/SD/SDR - abm*2.6*4 - HEAT12210 - put subscripts in correct order
; IHS/SD/SDR - 2.6*9 - HEAT35406 - Correction to itemized report
;
PRINT ;EP for printing data
S ABM("PG")=0
;W:$D(ABM("PRINT",16)) @ABM("PRINT",16) D HDB ;abm*2.6*9 HEAT35406
W:$D(ABM("PRINT",16)) @ABM("PRINT",16) D ^ABMDRHD,HDB ;abm*2.6*9 HEAT35406
S ABM("L")="",ABM("OL")=""
F ABM="N","B","PD","DD","WO","OB" S ABM("T"_ABM)=0
;F S ABM("L")=$O(^TMP(ABM("SUBR"),"ST",$J,ABM("L"))) Q:ABM("L")="" D ;abm*2.6*4 HEAT12210
F S ABM("L")=$O(^TMP(ABM("SUBR"),$J,"ST",ABM("L"))) Q:ABM("L")="" D ;abm*2.6*4 HEAT12210
.S ABM("V")=0 F ABM="N","B","PD","DD","WO","OB" S ABM("S"_ABM)=0
.;F S ABM("V")=$O(^TMP(ABM("SUBR"),"ST",$J,ABM("L"),ABM("V"))) Q:'ABM("V") D ;abm*2.6*4 HEAT12210
.F S ABM("V")=$O(^TMP(ABM("SUBR"),$J,"ST",ABM("L"),ABM("V"))) Q:'ABM("V") D ;abm*2.6*4 HEAT12210
..I $Y>(IOSL-5) D HD Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT) S ABM("OL")=""
..I ABM("L")'=ABM("OL") W !!,$E(ABM("L"),1,30) S ABM("OL")=ABM("L")
..W !
..I ABMY("SORT")="V" W ?17,$E($P(^ABMDVTYP(ABM("V"),0),U),1,25)
..I ABMY("SORT")="C" W ?17,$E($P(^DIC(40.7,ABM("V"),0),U),1,25)
..S ABM("I")=0
..F ABM="44^N","51^B","65^PD","79^DD","93^WO","107^OB" D
...S ABM("I")=ABM("I")+1
...;S ABM("P")=$P(^TMP(ABM("SUBR"),"ST",$J,ABM("L"),ABM("V"),0,0),U,ABM("I")) ;abm*2.6*4 HEAT12210
...S ABM("P")=$P(^TMP(ABM("SUBR"),$J,"ST",ABM("L"),ABM("V"),0,0),U,ABM("I")) ;abm*2.6*4 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))
...I +ABM=44 W ?44,$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)
.W !?44,"-----" F ABM=51,65,79,93,107 W ?ABM," ----------"
.W ?123,"------",!?36,"Total:",?44,$J($FN(ABM("SN"),",",0),5)
.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 !?43,"======" F ABM=51,65,79,93,107 W ?ABM," ==========="
.W ?123,"======",!?30,"Grand Total:",?44,$J($FN(ABM("TN"),",",0),5)
.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 Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
HDB S ABM("PG")=ABM("PG")+1 D WHD^ABMDRHD
W !,"Location",?42,"Number of",?55,"Amount",?69,"Amount",?81,"Deductible",?95,"Write Off",?108,"Outstanding",?121,"Collection"
W !?17,$S(ABMY("SORT")="C":"Clinic",1:"Visit Type"),?44,"Bills",?55,"Billed",?70,"Paid",?81,"and Co-Ins",?96,"Amount",?110,"Balance",?121,"Percentage"
S $P(ABM("LINE"),"-",132)="" W !,ABM("LINE") K ABM("LINE")
Q
;
XIT ;K ^TMP(ABM("SUBR"),"ST",$J) ;abm*2.6*4 HEAT12210
K ^TMP(ABM("SUBR"),$J,"ST") ;abm*2.6*4 HEAT12210
Q
ABMDRAL3 ; IHS/ASDST/DMJ - Bills Stats Report ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**4,9**;NOV 12, 2009
+2 ;Original;TMD;
+3 ; IHS/SD/SDR - abm*2.6*4 - HEAT12210 - put subscripts in correct order
+4 ; IHS/SD/SDR - 2.6*9 - HEAT35406 - Correction to itemized report
+5 ;
PRINT ;EP for printing data
+1 SET ABM("PG")=0
+2 ;W:$D(ABM("PRINT",16)) @ABM("PRINT",16) D HDB ;abm*2.6*9 HEAT35406
+3 ;abm*2.6*9 HEAT35406
IF $DATA(ABM("PRINT",16))
WRITE @ABM("PRINT",16)
DO ^ABMDRHD
DO HDB
+4 SET ABM("L")=""
SET ABM("OL")=""
+5 FOR ABM="N","B","PD","DD","WO","OB"
SET ABM("T"_ABM)=0
+6 ;F S ABM("L")=$O(^TMP(ABM("SUBR"),"ST",$J,ABM("L"))) Q:ABM("L")="" D ;abm*2.6*4 HEAT12210
+7 ;abm*2.6*4 HEAT12210
FOR
SET ABM("L")=$ORDER(^TMP(ABM("SUBR"),$JOB,"ST",ABM("L")))
IF ABM("L")=""
QUIT
Begin DoDot:1
+8 SET ABM("V")=0
FOR ABM="N","B","PD","DD","WO","OB"
SET ABM("S"_ABM)=0
+9 ;F S ABM("V")=$O(^TMP(ABM("SUBR"),"ST",$J,ABM("L"),ABM("V"))) Q:'ABM("V") D ;abm*2.6*4 HEAT12210
+10 ;abm*2.6*4 HEAT12210
FOR
SET ABM("V")=$ORDER(^TMP(ABM("SUBR"),$JOB,"ST",ABM("L"),ABM("V")))
IF 'ABM("V")
QUIT
Begin DoDot:2
+11 IF $Y>(IOSL-5)
DO HD
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
SET ABM("OL")=""
+12 IF ABM("L")'=ABM("OL")
WRITE !!,$EXTRACT(ABM("L"),1,30)
SET ABM("OL")=ABM("L")
+13 WRITE !
+14 IF ABMY("SORT")="V"
WRITE ?17,$EXTRACT($PIECE(^ABMDVTYP(ABM("V"),0),U),1,25)
+15 IF ABMY("SORT")="C"
WRITE ?17,$EXTRACT($PIECE(^DIC(40.7,ABM("V"),0),U),1,25)
+16 SET ABM("I")=0
+17 FOR ABM="44^N","51^B","65^PD","79^DD","93^WO","107^OB"
Begin DoDot:3
+18 SET ABM("I")=ABM("I")+1
+19 ;S ABM("P")=$P(^TMP(ABM("SUBR"),"ST",$J,ABM("L"),ABM("V"),0,0),U,ABM("I")) ;abm*2.6*4 HEAT12210
+20 ;abm*2.6*4 HEAT12210
SET ABM("P")=$PIECE(^TMP(ABM("SUBR"),$JOB,"ST",ABM("L"),ABM("V"),0,0),U,ABM("I"))
+21 SET ABM($PIECE(ABM,U,2))=ABM("P")
+22 SET ABM("T"_$PIECE(ABM,U,2))=ABM("P")+ABM("T"_$PIECE(ABM,U,2))
+23 SET ABM("S"_$PIECE(ABM,U,2))=ABM("P")+ABM("S"_$PIECE(ABM,U,2))
+24 IF +ABM=44
WRITE ?44,$JUSTIFY($FNUMBER(ABM("P"),",",0),5)
+25 IF '$TEST
WRITE ?+ABM,$JUSTIFY($FNUMBER(ABM("P"),",",2),12)
End DoDot:3
+26 WRITE ?124,$JUSTIFY($JUSTIFY($SELECT(ABM("B"):(ABM("PD")/ABM("B")*100),1:0),".",1),5)
End DoDot:2
+27 WRITE !?44,"-----"
FOR ABM=51,65,79,93,107
WRITE ?ABM," ----------"
+28 WRITE ?123,"------",!?36,"Total:",?44,$JUSTIFY($FNUMBER(ABM("SN"),",",0),5)
+29 FOR ABM="51^B","65^PD","79^DD","93^WO","107^OB"
WRITE ?+ABM,$JUSTIFY($FNUMBER(ABM("S"_$PIECE(ABM,U,2)),",",2),12)
+30 WRITE ?124,$JUSTIFY($JUSTIFY($SELECT(ABM("SB"):(ABM("SPD")/ABM("SB")*100),1:0),".",1),5)
End DoDot:1
+31 IF ABM("TN")'=+$GET(ABM("SN"))
Begin DoDot:1
+32 WRITE !?43,"======"
FOR ABM=51,65,79,93,107
WRITE ?ABM," ==========="
+33 WRITE ?123,"======",!?30,"Grand Total:",?44,$JUSTIFY($FNUMBER(ABM("TN"),",",0),5)
+34 FOR ABM="51^B","65^PD","79^DD","93^WO","107^OB"
WRITE ?+ABM,$JUSTIFY($FNUMBER(ABM("T"_$PIECE(ABM,U,2)),",",2),12)
+35 WRITE ?124,$JUSTIFY($JUSTIFY($SELECT(ABM("TB"):(ABM("TPD")/ABM("TB")*100),1:0),".",1),5)
End DoDot:1
+36 GOTO XIT
+37 ;
HD DO PAZ^ABMDRUTL
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
HDB SET ABM("PG")=ABM("PG")+1
DO WHD^ABMDRHD
+1 WRITE !,"Location",?42,"Number of",?55,"Amount",?69,"Amount",?81,"Deductible",?95,"Write Off",?108,"Outstanding",?121,"Collection"
+2 WRITE !?17,$SELECT(ABMY("SORT")="C":"Clinic",1:"Visit Type"),?44,"Bills",?55,"Billed",?70,"Paid",?81,"and Co-Ins",?96,"Amount",?110,"Balance",?121,"Percentage"
+3 SET $PIECE(ABM("LINE"),"-",132)=""
WRITE !,ABM("LINE")
KILL ABM("LINE")
+4 QUIT
+5 ;
XIT ;K ^TMP(ABM("SUBR"),"ST",$J) ;abm*2.6*4 HEAT12210
+1 ;abm*2.6*4 HEAT12210
KILL ^TMP(ABM("SUBR"),$JOB,"ST")
+2 QUIT
