- 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
