ABMDPAYV ; IHS/ASDST/DMJ - View Payment Activity ;
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;
W $$EN^ABMVDF("IOF")
N ABM
S ABM="",$P(ABM,"-",80)="" W !,ABM
PREV S (ABM("TB"),ABM("TP"),ABM("TW"),ABM("TD"))=0
W !?25,"***** BILLING ACTIVITY ******"
W !?1,"Bill",?35,"Amount",?45,"Amount",?54,"Co-Ins",?62,"Write"
W !,"Number",?16,"Insurer",?35,"Billed",?46,"Paid",?54,"Deduct",?63,"Off",?71,"Balance"
S ABM="",$P(ABM,"=",80)="" W !,ABM
S ABM("C")="" F S ABM("C")=$O(^ABMDBILL(DUZ(2),"AS",+ABMP("BILL"),ABM("C"))) Q:ABM("C")="" S ABM=$O(^(ABM("C"),"")) Q:'ABM D
.S ABM=0 F ABM("I")=1:1 S ABM=$O(^ABMDBILL(DUZ(2),"AS",+ABMP("BILL"),ABM("C"),ABM)) Q:'ABM D
..Q:$P($G(^ABMDBILL(DUZ(2),ABM,0)),U,5)'=ABMP("PDFN")
..S ABM("D",$P(^ABMDBILL(DUZ(2),ABM,0),U))=ABM
S ABM("L")="" F S ABM("L")=$O(ABM("D",ABM("L"))) Q:ABM("L")="" D
.S ABM=ABM("D",ABM("L"))
.S ABM("OB")=+$G(^ABMDBILL(DUZ(2),ABM,2)) S ABM("TB")=ABM("TB")+ABM("OB")
.W !,$P(^ABMDBILL(DUZ(2),ABM,0),U),?8,$E($P(^AUTNINS($P(^(0),U,8),0),U),1,25)
.W ?34,$J($FN(ABM("OB"),",",2),9)
.S ABM("J")=0 F ABM("K")=1:1 S ABM("J")=$O(^ABMDBILL(DUZ(2),ABM,3,ABM("J"))) Q:'ABM("J") W:ABM("K")>1 ! D
..S ABM("P0")=^ABMDBILL(DUZ(2),ABM,3,ABM("J"),0),ABM("PD")=$P(^(0),U,2),ABM("DD")=$P(^(0),U,3)+$P(^(0),U,4),ABM("WO")=$P(^(0),U,6)
..S ABM("OB")=ABM("OB")-ABM("DD")-ABM("PD")-ABM("WO")
..S ABM("TW")=ABM("TW")+ABM("WO")
..S ABM("TP")=ABM("PD")+ABM("TP"),ABM("TD")=ABM("TD")+ABM("DD")
..W ?44,$J($FN(ABM("PD"),",",2),9)
..W ?54,$J($FN(ABM("DD"),",",0),5)
..W ?60,$J($FN(ABM("WO"),",",2),9)
..W:'$O(^ABMDBILL(DUZ(2),ABM,3,ABM("J"))) ?70,$J($FN(ABM("OB"),",",2),9)
I ABM("I")>1 D I 1
.S ABM("OB")=ABM("TB")-ABM("TD")-ABM("TP")-ABM("TW")
.W !,?34,"--------- --------- ----- --------- ---------"
.W !,?34,$J($FN(ABM("TB"),",",2),9),?44,$J($FN(ABM("TP"),",",2),9)
.W ?54,$J($FN(ABM("TD"),",",0),5)
.W ?60,$J($FN(ABM("TW"),",",2),9),?70,$J($FN(ABM("OB"),",",2),9)
E W !
S ABM="",$P(ABM,"-",80)="" W !,ABM
W ! K DIR S DIR(0)="E" D ^DIR K DIR
Q
;
DISP ; EP for displaying bill payment summary
K ABM("I") S (ABM("I"),ABM("PDT"))=0 F S ABM("PDT")=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),3,"B",ABM("PDT"))) Q:'ABM("PDT") D
.S ABM=0 F S ABM=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),3,"B",ABM("PDT"),ABM)) Q:'ABM D
..S ABM("P0")=^ABMDBILL(DUZ(2),ABMP("BDFN"),3,ABM,0),ABM("I")=ABM("I")+1
..S ABM(ABM("I"))=ABM("P0"),ABM("I",ABM("I"))=ABM
..S ABM("DD")=$P(ABM("P0"),U,3)+$P(ABM("P0"),U,4)
..S ABM("WO")=+$P(ABM("P0"),U,6),ABM("PD")=+$P(ABM("P0"),U,2)
..S ABM("OB")=ABM("OBL")-ABM("DD")-ABM("WO")-ABM("PD")
..;I 'ABM("WO"),$P(ABMP("B0"),U,4)="C",ABM("OB")>0,'$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),3,ABM)) S ABM("WO")=ABM("OB"),ABM("OB")=0,DA(1)=ABMP("BDFN"),DIE="^ABMDBILL(DUZ(2),"_DA(1)_",3,",DA=ABM,DR=".06////"_ABM("WO") D ^DIE
..W !,"[",ABM("I"),"]"
..I ABM("I")=1 W ?5,$J(($FN(ABM("BL"),",",2)),10)
..W ?17,$$HDT^ABMDUTL(+ABM("P0"))
..W ?27,$J(($FN(ABM("PD"),",",2)),10)
..W ?39,$J(($FN(ABM("DD"),",",2)),10)
..W ?51,$J(($FN(ABM("WO"),",",2)),10)
..W ?63,$J(($FN(ABM("OB"),",",2)),10)
..F ABM("T")="1^PD","2^DD","3^WO" S $P(ABM("TOT"),U,+ABM("T"))=$P(ABM("TOT"),U,+ABM("T"))+ABM($P(ABM("T"),U,2))
..S $P(ABM("TOT"),U,4)=ABM("OB")
..S ABM("OBL")=ABM("OB")
Q
ABMDPAYV ; IHS/ASDST/DMJ - View Payment Activity ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ;
+3 WRITE $$EN^ABMVDF("IOF")
+4 NEW ABM
+5 SET ABM=""
SET $PIECE(ABM,"-",80)=""
WRITE !,ABM
PREV SET (ABM("TB"),ABM("TP"),ABM("TW"),ABM("TD"))=0
+1 WRITE !?25,"***** BILLING ACTIVITY ******"
+2 WRITE !?1,"Bill",?35,"Amount",?45,"Amount",?54,"Co-Ins",?62,"Write"
+3 WRITE !,"Number",?16,"Insurer",?35,"Billed",?46,"Paid",?54,"Deduct",?63,"Off",?71,"Balance"
+4 SET ABM=""
SET $PIECE(ABM,"=",80)=""
WRITE !,ABM
+5 SET ABM("C")=""
FOR
SET ABM("C")=$ORDER(^ABMDBILL(DUZ(2),"AS",+ABMP("BILL"),ABM("C")))
IF ABM("C")=""
QUIT
SET ABM=$ORDER(^(ABM("C"),""))
IF 'ABM
QUIT
Begin DoDot:1
+6 SET ABM=0
FOR ABM("I")=1:1
SET ABM=$ORDER(^ABMDBILL(DUZ(2),"AS",+ABMP("BILL"),ABM("C"),ABM))
IF 'ABM
QUIT
Begin DoDot:2
+7 IF $PIECE($GET(^ABMDBILL(DUZ(2),ABM,0)),U,5)'=ABMP("PDFN")
QUIT
+8 SET ABM("D",$PIECE(^ABMDBILL(DUZ(2),ABM,0),U))=ABM
End DoDot:2
End DoDot:1
+9 SET ABM("L")=""
FOR
SET ABM("L")=$ORDER(ABM("D",ABM("L")))
IF ABM("L")=""
QUIT
Begin DoDot:1
+10 SET ABM=ABM("D",ABM("L"))
+11 SET ABM("OB")=+$GET(^ABMDBILL(DUZ(2),ABM,2))
SET ABM("TB")=ABM("TB")+ABM("OB")
+12 WRITE !,$PIECE(^ABMDBILL(DUZ(2),ABM,0),U),?8,$EXTRACT($PIECE(^AUTNINS($PIECE(^(0),U,8),0),U),1,25)
+13 WRITE ?34,$JUSTIFY($FNUMBER(ABM("OB"),",",2),9)
+14 SET ABM("J")=0
FOR ABM("K")=1:1
SET ABM("J")=$ORDER(^ABMDBILL(DUZ(2),ABM,3,ABM("J")))
IF 'ABM("J")
QUIT
IF ABM("K")>1
WRITE !
Begin DoDot:2
+15 SET ABM("P0")=^ABMDBILL(DUZ(2),ABM,3,ABM("J"),0)
SET ABM("PD")=$PIECE(^(0),U,2)
SET ABM("DD")=$PIECE(^(0),U,3)+$PIECE(^(0),U,4)
SET ABM("WO")=$PIECE(^(0),U,6)
+16 SET ABM("OB")=ABM("OB")-ABM("DD")-ABM("PD")-ABM("WO")
+17 SET ABM("TW")=ABM("TW")+ABM("WO")
+18 SET ABM("TP")=ABM("PD")+ABM("TP")
SET ABM("TD")=ABM("TD")+ABM("DD")
+19 WRITE ?44,$JUSTIFY($FNUMBER(ABM("PD"),",",2),9)
+20 WRITE ?54,$JUSTIFY($FNUMBER(ABM("DD"),",",0),5)
+21 WRITE ?60,$JUSTIFY($FNUMBER(ABM("WO"),",",2),9)
+22 IF '$ORDER(^ABMDBILL(DUZ(2),ABM,3,ABM("J")))
WRITE ?70,$JUSTIFY($FNUMBER(ABM("OB"),",",2),9)
End DoDot:2
End DoDot:1
+23 IF ABM("I")>1
Begin DoDot:1
+24 SET ABM("OB")=ABM("TB")-ABM("TD")-ABM("TP")-ABM("TW")
+25 WRITE !,?34,"--------- --------- ----- --------- ---------"
+26 WRITE !,?34,$JUSTIFY($FNUMBER(ABM("TB"),",",2),9),?44,$JUSTIFY($FNUMBER(ABM("TP"),",",2),9)
+27 WRITE ?54,$JUSTIFY($FNUMBER(ABM("TD"),",",0),5)
+28 WRITE ?60,$JUSTIFY($FNUMBER(ABM("TW"),",",2),9),?70,$JUSTIFY($FNUMBER(ABM("OB"),",",2),9)
End DoDot:1
IF 1
+29 IF '$TEST
WRITE !
+30 SET ABM=""
SET $PIECE(ABM,"-",80)=""
WRITE !,ABM
+31 WRITE !
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
+32 QUIT
+33 ;
DISP ; EP for displaying bill payment summary
+1 KILL ABM("I")
SET (ABM("I"),ABM("PDT"))=0
FOR
SET ABM("PDT")=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),3,"B",ABM("PDT")))
IF 'ABM("PDT")
QUIT
Begin DoDot:1
+2 SET ABM=0
FOR
SET ABM=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),3,"B",ABM("PDT"),ABM))
IF 'ABM
QUIT
Begin DoDot:2
+3 SET ABM("P0")=^ABMDBILL(DUZ(2),ABMP("BDFN"),3,ABM,0)
SET ABM("I")=ABM("I")+1
+4 SET ABM(ABM("I"))=ABM("P0")
SET ABM("I",ABM("I"))=ABM
+5 SET ABM("DD")=$PIECE(ABM("P0"),U,3)+$PIECE(ABM("P0"),U,4)
+6 SET ABM("WO")=+$PIECE(ABM("P0"),U,6)
SET ABM("PD")=+$PIECE(ABM("P0"),U,2)
+7 SET ABM("OB")=ABM("OBL")-ABM("DD")-ABM("WO")-ABM("PD")
+8 ;I 'ABM("WO"),$P(ABMP("B0"),U,4)="C",ABM("OB")>0,'$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),3,ABM)) S ABM("WO")=ABM("OB"),ABM("OB")=0,DA(1)=ABMP("BDFN"),DIE="^ABMDBILL(DUZ(2),"_DA(1)_",3,",DA=ABM,DR=".06////"_ABM("WO") D ^DIE
+9 WRITE !,"[",ABM("I"),"]"
+10 IF ABM("I")=1
WRITE ?5,$JUSTIFY(($FNUMBER(ABM("BL"),",",2)),10)
+11 WRITE ?17,$$HDT^ABMDUTL(+ABM("P0"))
+12 WRITE ?27,$JUSTIFY(($FNUMBER(ABM("PD"),",",2)),10)
+13 WRITE ?39,$JUSTIFY(($FNUMBER(ABM("DD"),",",2)),10)
+14 WRITE ?51,$JUSTIFY(($FNUMBER(ABM("WO"),",",2)),10)
+15 WRITE ?63,$JUSTIFY(($FNUMBER(ABM("OB"),",",2)),10)
+16 FOR ABM("T")="1^PD","2^DD","3^WO"
SET $PIECE(ABM("TOT"),U,+ABM("T"))=$PIECE(ABM("TOT"),U,+ABM("T"))+ABM($PIECE(ABM("T"),U,2))
+17 SET $PIECE(ABM("TOT"),U,4)=ABM("OB")
+18 SET ABM("OBL")=ABM("OB")
End DoDot:2
End DoDot:1
+19 QUIT
