- 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
