- 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
