ABMDRAL3.m

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