ABMDPAY ; IHS/ASDST/DMJ - Payment of Bill ;
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;
S Y=1 I $L($T(TPB^BARUP)) D Q:'Y
.W !!,$$EN^ABMVDF("RVN"),"NOTE:",$$EN^ABMVDF("RVF")
.W " It appears the new A/R package has been installed."
.W !,"Payments should be posted in the new A/R package.",!
.S DIR(0)="Y",DIR("A")="Continue",DIR("B")="NO" D ^DIR K DIR
SEL K DIC,ABMP S U="^",ABMP("I")=0
K DIR S DIR(0)="YO",DIR("B")="Y" W !
S DIR("A")="Screen-out the Selection of Bills that are Completed"
S DIR("?")="Answer YES if those Bills that are in a Completed Status (unobligated balance equal to zero) are to be screened out (unselectable)."
D ^DIR K DIR
G XIT:$D(DIRUT)!$D(DIROUT)
K ABMP("BDFN") D ^ABMDBDIC G XIT:'$G(ABMP("BDFN"))
L +^ABMDBILL(DUZ(2),ABMP("BDFN"),0):1 I '$T W *7,!!,"Record is in USE by another User, try Later!" G XIT
I $P($G(^AUTNINS(+$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U,8),2)),U)="I" W *7,!!,"Payment can't be Posted for BENEFICIARY PATIENT Bills!" K DIR S DIR(0)="E" D ^DIR G XIT
S ABMP("SPAY")=0
I "AR"[$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U,4) D G SEL:'ABMP("SPAY")
.I $P($G(^AUTNINS(+$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U,8),2)),U)'="N" W *7,!!,"Payment can only be Posted for Bills that have been Printed!" Q
.S ABMP("SPAY")=1
.W *7,!!,"Although this Bill has not yet been Printed, since the Patient is Self Pay,"
.W !,"payment can still be posted. If payment is posted the Bill will be removed",!,"from the batch print queue.",!
S ABMP("BILL")=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U),ABMP("B0")=^(0),ABMP("VDT")=$S($P(^(0),U,7)=111:$P($G(^(6)),U),1:$P($G(^(7)),U))
I $P(ABMP("B0"),U,4)="C",'$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),3,0)) S DIE="^ABMDBILL(DUZ(2),",DA=ABMP("BDFN"),DR=".04////B",$P(ABMP("B0"),U,4)="B" D ^DIE
S ABMP("INS")=$P(ABMP("B0"),U,8),ABMP("VTYP")=$P(ABMP("B0"),U,7),ABMP("LDFN")=$P(ABMP("B0"),U,3),ABMP("PDFN")=$P(ABMP("B0"),U,5)
S ABMP("SIS")=0,ABM=0 F S ABM=$O(^ABMDCLM(DUZ(2),+ABMP("BILL"),65,ABM)) Q:'ABM D Q:+ABMP("SIS")
.I ABM'=ABMP("BDFN"),$D(^ABMDCLM(DUZ(2),+ABMP("BILL"),65,ABMP("BDFN"),0)),$D(^ABMDBILL(DUZ(2),ABM,0)),+^(0)=+ABMP("BILL") S ABMP("SIS")=$P(^(0),U)_U_$P($G(^(2)),U,5) Q
;
DISP K ABM W $$EN^ABMVDF("IOF")
S ABMP="",$P(ABMP,"~",32)="",ABMP("I")=ABMP("I")+1
W !,ABMP," PAYMENT POSTING ",ABMP
W !,"Patient: ",$P(^DPT(ABMP("PDFN"),0),U,1)," ",$$HRN^ABMDUTL(ABMP("PDFN"))
W ?55,$P(^DPT(ABMP("PDFN"),0),U,2),?59,$$HDT^ABMDUTL($P(^(0),U,3)),?70,$P(^(0),U,9)
S ABMP="",$P(ABMP,".",80)="" W !,ABMP
W !,"Visit: ",$$HDT^ABMDUTL(ABMP("VDT"))
W ?17,$E($P(^DIC(4,ABMP("LDFN"),0),U),1,30)
W ?50,$E($P(^ABMDVTYP(ABMP("VTYP"),0),U),1,14)
I $P(ABMP("B0"),U,10) W ?66,$J($E($P(^DIC(40.7,$P(ABMP("B0"),U,10),0),U),1,14),13)
BL S ABM("BL")=+^ABMDBILL(DUZ(2),ABMP("BDFN"),2),ABM("ST")=$P(^(0),U,4)
S ABM("OBL")=ABM("BL")
S ABM("Y0")=$P(^DD(9002274.4,.04,0),U,3),ABM("Y0")=$P($P(ABM("Y0"),ABM("ST")_":",2),";",1)
W !," Bill: ",ABMP("BILL"),?17,$E($P(^AUTNINS(ABMP("INS"),0),U),1,30),?50,$E(ABM("Y0"),1,15),?68,$J("$"_$FN(ABM("BL"),",",2),11)
S ABMP="",$P(ABMP,"-",80)="" W !,ABMP
W !!?7,"Amount",?17,"Payment",?41,"Deduct",?51,"Write Off-"
W !?7,"Billed",?19,"Date",?28,"Payment",?41,"Co-Ins",?51,"Adjustment",?64,"Balance"
W !?5,"========== ======== ========== ========== ========== =========="
S ABM("TOT")=0,ABM("I")=0
D DISP^ABMDPAYV
I ABM("I")>1 D I 1
.W !?5,"----------",?27,"---------- ---------- ---------- ----------"
.W !?5,$J($FN(ABM("BL"),",",2),10)
.F ABM=1:1:4 W ?(ABM*12+15),$J($FN($P(ABM("TOT"),U,ABM),",",2),10)
E W !
S ABM("OB")=$S($P(ABM("TOT"),U,4)="":ABM("BL"),1:$P(ABM("TOT"),U,4))
I ABM("OB")'=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),2),U,5) S DIE="^ABMDBILL(DUZ(2),",DA=ABMP("BDFN"),DR=".25////"_ABM("OB") D ^DIE
I ABM("I")=0 W ?5,$J(($FN(ABM("BL"),",",2)),10)
S ABM="",$P(ABM,"-",80)="" W !,ABM
I ABMP("SIS") W !,"NOTE: A Sister Bill (",$P(ABMP("SIS"),U),") exists with a balance of $",$FN($P(ABMP("SIS"),U,2),",",2),!,ABM
S ABM("DFLT")=$S(ABMP("I")>1:"",ABM("ST")="C":"E",1:"A")
S ABM("OPT")=$S(ABM("ST")="C":"EVQ",ABM("I"):"ADEVQ",1:"AVQ")
D SEL^ABMDPOPT
G XIT:$D(DIROUT)!$D(DTOUT)!$D(DUOUT)!("ADEV"'[$E(Y)),SEL:$D(DIRUT)
W ! D @($E(Y)_"^ABMDPAY1")
G XIT:$D(DTOUT)!$D(DUOUT),SEL:$G(ABMP("PAYM")),DISP
;
XIT ;CLEAN UP AND QUIT
I $G(ABMP("BDFN")) L -^ABMDBILL(DUZ(2),ABMP("BDFN"),0)
K ABMP,ABM
Q
ABMDPAY ; IHS/ASDST/DMJ - Payment of Bill ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ;
+3 SET Y=1
IF $LENGTH($TEXT(TPB^BARUP))
Begin DoDot:1
+4 WRITE !!,$$EN^ABMVDF("RVN"),"NOTE:",$$EN^ABMVDF("RVF")
+5 WRITE " It appears the new A/R package has been installed."
+6 WRITE !,"Payments should be posted in the new A/R package.",!
+7 SET DIR(0)="Y"
SET DIR("A")="Continue"
SET DIR("B")="NO"
DO ^DIR
KILL DIR
End DoDot:1
IF 'Y
QUIT
SEL KILL DIC,ABMP
SET U="^"
SET ABMP("I")=0
+1 KILL DIR
SET DIR(0)="YO"
SET DIR("B")="Y"
WRITE !
+2 SET DIR("A")="Screen-out the Selection of Bills that are Completed"
+3 SET DIR("?")="Answer YES if those Bills that are in a Completed Status (unobligated balance equal to zero) are to be screened out (unselectable)."
+4 DO ^DIR
KILL DIR
+5 IF $DATA(DIRUT)!$DATA(DIROUT)
GOTO XIT
+6 KILL ABMP("BDFN")
DO ^ABMDBDIC
IF '$GET(ABMP("BDFN"))
GOTO XIT
+7 LOCK +^ABMDBILL(DUZ(2),ABMP("BDFN"),0):1
IF '$TEST
WRITE *7,!!,"Record is in USE by another User, try Later!"
GOTO XIT
+8 IF $PIECE($GET(^AUTNINS(+$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U,8),2)),U)="I"
WRITE *7,!!,"Payment can't be Posted for BENEFICIARY PATIENT Bills!"
KILL DIR
SET DIR(0)="E"
DO ^DIR
GOTO XIT
+9 SET ABMP("SPAY")=0
+10 IF "AR"[$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U,4)
Begin DoDot:1
+11 IF $PIECE($GET(^AUTNINS(+$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U,8),2)),U)'="N"
WRITE *7,!!,"Payment can only be Posted for Bills that have been Printed!"
QUIT
+12 SET ABMP("SPAY")=1
+13 WRITE *7,!!,"Although this Bill has not yet been Printed, since the Patient is Self Pay,"
+14 WRITE !,"payment can still be posted. If payment is posted the Bill will be removed",!,"from the batch print queue.",!
End DoDot:1
IF 'ABMP("SPAY")
GOTO SEL
+15 SET ABMP("BILL")=$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U)
SET ABMP("B0")=^(0)
SET ABMP("VDT")=$SELECT($PIECE(^(0),U,7)=111:$PIECE($GET(^(6)),U),1:$PIECE($GET(^(7)),U))
+16 IF $PIECE(ABMP("B0"),U,4)="C"
IF '$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),3,0))
SET DIE="^ABMDBILL(DUZ(2),"
SET DA=ABMP("BDFN")
SET DR=".04////B"
SET $PIECE(ABMP("B0"),U,4)="B"
DO ^DIE
+17 SET ABMP("INS")=$PIECE(ABMP("B0"),U,8)
SET ABMP("VTYP")=$PIECE(ABMP("B0"),U,7)
SET ABMP("LDFN")=$PIECE(ABMP("B0"),U,3)
SET ABMP("PDFN")=$PIECE(ABMP("B0"),U,5)
+18 SET ABMP("SIS")=0
SET ABM=0
FOR
SET ABM=$ORDER(^ABMDCLM(DUZ(2),+ABMP("BILL"),65,ABM))
IF 'ABM
QUIT
Begin DoDot:1
+19 IF ABM'=ABMP("BDFN")
IF $DATA(^ABMDCLM(DUZ(2),+ABMP("BILL"),65,ABMP("BDFN"),0))
IF $DATA(^ABMDBILL(DUZ(2),ABM,0))
IF +^(0)=+ABMP("BILL")
SET ABMP("SIS")=$PIECE(^(0),U)_U_$PIECE($GET(^(2)),U,5)
QUIT
End DoDot:1
IF +ABMP("SIS")
QUIT
+20 ;
DISP KILL ABM
WRITE $$EN^ABMVDF("IOF")
+1 SET ABMP=""
SET $PIECE(ABMP,"~",32)=""
SET ABMP("I")=ABMP("I")+1
+2 WRITE !,ABMP," PAYMENT POSTING ",ABMP
+3 WRITE !,"Patient: ",$PIECE(^DPT(ABMP("PDFN"),0),U,1)," ",$$HRN^ABMDUTL(ABMP("PDFN"))
+4 WRITE ?55,$PIECE(^DPT(ABMP("PDFN"),0),U,2),?59,$$HDT^ABMDUTL($PIECE(^(0),U,3)),?70,$PIECE(^(0),U,9)
+5 SET ABMP=""
SET $PIECE(ABMP,".",80)=""
WRITE !,ABMP
+6 WRITE !,"Visit: ",$$HDT^ABMDUTL(ABMP("VDT"))
+7 WRITE ?17,$EXTRACT($PIECE(^DIC(4,ABMP("LDFN"),0),U),1,30)
+8 WRITE ?50,$EXTRACT($PIECE(^ABMDVTYP(ABMP("VTYP"),0),U),1,14)
+9 IF $PIECE(ABMP("B0"),U,10)
WRITE ?66,$JUSTIFY($EXTRACT($PIECE(^DIC(40.7,$PIECE(ABMP("B0"),U,10),0),U),1,14),13)
BL SET ABM("BL")=+^ABMDBILL(DUZ(2),ABMP("BDFN"),2)
SET ABM("ST")=$PIECE(^(0),U,4)
+1 SET ABM("OBL")=ABM("BL")
+2 SET ABM("Y0")=$PIECE(^DD(9002274.4,.04,0),U,3)
SET ABM("Y0")=$PIECE($PIECE(ABM("Y0"),ABM("ST")_":",2),";",1)
+3 WRITE !," Bill: ",ABMP("BILL"),?17,$EXTRACT($PIECE(^AUTNINS(ABMP("INS"),0),U),1,30),?50,$EXTRACT(ABM("Y0"),1,15),?68,$JUSTIFY("$"_$FNUMBER(ABM("BL"),",",2),11)
+4 SET ABMP=""
SET $PIECE(ABMP,"-",80)=""
WRITE !,ABMP
+5 WRITE !!?7,"Amount",?17,"Payment",?41,"Deduct",?51,"Write Off-"
+6 WRITE !?7,"Billed",?19,"Date",?28,"Payment",?41,"Co-Ins",?51,"Adjustment",?64,"Balance"
+7 WRITE !?5,"========== ======== ========== ========== ========== =========="
+8 SET ABM("TOT")=0
SET ABM("I")=0
+9 DO DISP^ABMDPAYV
+10 IF ABM("I")>1
Begin DoDot:1
+11 WRITE !?5,"----------",?27,"---------- ---------- ---------- ----------"
+12 WRITE !?5,$JUSTIFY($FNUMBER(ABM("BL"),",",2),10)
+13 FOR ABM=1:1:4
WRITE ?(ABM*12+15),$JUSTIFY($FNUMBER($PIECE(ABM("TOT"),U,ABM),",",2),10)
End DoDot:1
IF 1
+14 IF '$TEST
WRITE !
+15 SET ABM("OB")=$SELECT($PIECE(ABM("TOT"),U,4)="":ABM("BL"),1:$PIECE(ABM("TOT"),U,4))
+16 IF ABM("OB")'=$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),2),U,5)
SET DIE="^ABMDBILL(DUZ(2),"
SET DA=ABMP("BDFN")
SET DR=".25////"_ABM("OB")
DO ^DIE
+17 IF ABM("I")=0
WRITE ?5,$JUSTIFY(($FNUMBER(ABM("BL"),",",2)),10)
+18 SET ABM=""
SET $PIECE(ABM,"-",80)=""
WRITE !,ABM
+19 IF ABMP("SIS")
WRITE !,"NOTE: A Sister Bill (",$PIECE(ABMP("SIS"),U),") exists with a balance of $",$FNUMBER($PIECE(ABMP("SIS"),U,2),",",2),!,ABM
+20 SET ABM("DFLT")=$SELECT(ABMP("I")>1:"",ABM("ST")="C":"E",1:"A")
+21 SET ABM("OPT")=$SELECT(ABM("ST")="C":"EVQ",ABM("I"):"ADEVQ",1:"AVQ")
+22 DO SEL^ABMDPOPT
+23 IF $DATA(DIROUT)!$DATA(DTOUT)!$DATA(DUOUT)!("ADEV"'[$EXTRACT(Y))
GOTO XIT
IF $DATA(DIRUT)
GOTO SEL
+24 WRITE !
DO @($EXTRACT(Y)_"^ABMDPAY1")
+25 IF $DATA(DTOUT)!$DATA(DUOUT)
GOTO XIT
IF $GET(ABMP("PAYM"))
GOTO SEL
GOTO DISP
+26 ;
XIT ;CLEAN UP AND QUIT
+1 IF $GET(ABMP("BDFN"))
LOCK -^ABMDBILL(DUZ(2),ABMP("BDFN"),0)
+2 KILL ABMP,ABM
+3 QUIT
