BARFPST3 ; IHS/SD/LSL - A/R FLAT RATE POSTING #3 ; 01/09/2009
;;1.8;IHS ACCOUNTS RECEIVABLE;**1,6,10,21,23**;OCT 26, 2005
Q
; *********************************************************************
DISP ; EP
; Display Accumulated posted amount and posting balance from
; A/R FLAT RATE POSTING File before making entries
; BARBIEN = IEN to A/R BILLS mult in VISIT LOCATION mult in FRP File
; J = Bill Counter
S (J,BARBIEN)=0
F S BARBIEN=$O(^BARFRP(DUZ(2),BARIEN,2,BARFIEN,3,BARBIEN)) Q:'+BARBIEN S J=J+1
S BARAPST=+$G(BARPAY)*J ; Amount To Post
S BARBAL=BARPAMT-BARAPST ; Remaining Balance
W !!,"Amount To Post: ",BARAPST,?30,"Remaining Balance: ",BARBAL
Q
; *********************************************************************
FRPBILL ; EP
; EP - Continue top-level loop logic
S BARFLAG=0 ; Review flag (no posting)
S BARPDBY=$$VALI^XBDIQ1(90051.1101,"BARCOL,BARITM",7) ; Payor on item
F D BILLS Q:'+BARBIL ; Ask A/R bills loop
Q
; *********************************************************************
BILLS ;
; Loop through and enter/edit A/R Bills multiple in
; A/R FLAT RATE POSTING File
; BARFPASS = Patient^DOS Start^DOS End^A/R BILL IEN^FRP BILL IEN
K BARPAT,BARZ
S BARBIL=1 ; Bill Entry Loop Flag
S BARFPASS=$$GETBIL^BARFPST3 ; Get bills by bill, patient, or DOS
I BARFPASS=0 S BARBIL=0 Q ; No bill selected; End loop
S BARPASS=$P(BARFPASS,U,1,3) ; Patient^DOS Start^DOS End
; If no A/R Bill IEN
I '+$P(BARFPASS,U,4) D FINDBIL Q:'BARCNT Q:'+BARASK
; The user selected a bill from ^BARFRP; Ask delete
; (Can only be done through EDIT)
I $P(BARFPASS,U,5)]"" D DELBIL Q
S BARBLHLD=+$P(BARFPASS,U,4)
; Bill entered already in ^BARFRP. don't add again
I $D(^BARFRP(DUZ(2),BARIEN,2,BARFIEN,3,"B",BARBLHLD)) D Q
. W !,$$VAL^XBDIQ1(90050.01,BARBLHLD,.01)
. W " has already been entered."
D PAYOR Q:'+BARPAYOR ; If payors differ, notify user
D BILEXIST Q:'+BARBILE ; Check for bill in different FRP batch
;D NEGBILL Q:'+BARBILB ; Check for neg balance on bill ;MRS:BAR*1.8*10 H632
I $$IHS^BARUFUT(DUZ(2)) D NEGBILL Q:'+BARBILB ;MRS:BAR*1.8*10 H632
;;;I $$IHSERA^BARUFUT(DUZ(2)) D NEGBILL Q:'+BARBILB ;P.OTT
; Display amount posted (accumulated) and remaining balance
S BARAPST=BARAPST+$G(BARPAY) ; Amount To Post
S BARBAL=BARPAMT-BARAPST ; Remaining Balance
W !,"Amount To Post: ",BARAPST,?30,"Remaining Balance: ",BARBAL
; If posting results in negative balance, stop and send to review
;I BARBAL<0 D Q ;MRS:BAR*1.8*10 H632
I $$IHS^BARUFUT(DUZ(2)),BARBAL<0 D Q ;MRS:BAR*1.8*10 H632
. ;;;I $$IHSERA^BARUFUT(DUZ(2)),BARBAL<0 D Q ;P.OTT
. W !,"Posting this payment will result in a negative balance."
. S BARAPST=BARAPST-$G(BARPAY)
. S BARBAL=BARPAMT-BARAPST
. S BARBIL=0
D SAVEBIL ; Save Bill to A/R FLAT RATE POSTING file
Q
; *********************************************************************
GETBIL() ; EP
; EP - Flat Rate Posting - Bill Entry
; If Editing, ask Flat Rate Posting Bill
;IHS/SD/TPF BAR*1.8*21 8/3/2011 HEAT20490
I $$NOTOPEN^BARUFUT(.DUZ,$G(UFMSESID)) Q 0 ;IS SESSION STILL OPEN
G CONT
GETBIL2() ;EP for Calls that don't need open Cashiering Sessions
CONT ; Remarks entry: BARPRMKP
; End 1.8*21
I $G(BARRECPQ)="E" D SELFRBIL^BARFPST3 I $G(BARZ) Q BARZ
D SELBILL^BARPUTL ; Ask A/R BILL
I $G(BARZ) D Q BARZ
. S BARBL=+Y ; IEN to A/R IHS BILL File
. S $P(BARZ,U,4)=BARBL
D ASKPAT^BARPUTL ; If bill not answered, ask patient
I $G(BARZ) Q BARZ
D GETBIL^BARPUTL ; If patient not answered, ask DOS
I $G(BARZ) Q BARZ
Q 0 ; No bills entered
; *********************************************************************
SELFRBIL ; EP
; EP - look up into A/R FLAT RATE POSTING File if EDIT
K DIC
S DA(1)=BARFIEN ; IEN to VISIT LOC mult in A/R FRP File
S DA(2)=BARIEN ; IEN to A/R FLAT RATE POSTING File
S DIC="^BARFRP(DUZ(2),DA(2),2,DA(1),3,"
S DIC("A")="Select Flat Rate Post BILL: "
S DIC(0)="AEZMQ"
; Write patient name next to Bill number
S DIC("W")="D SELFRID^BARFPST3"
D ^DIC
Q:+Y<1
S BARPAT=$P(^BARBL(DUZ(2),+Y(0),1),U) ; A/R patient
S BARSTART=$P(^BARBL(DUZ(2),+Y(0),1),U,2) ; DOS Start date
S BAREND=$P(^BARBL(DUZ(2),+Y(0),1),U,3) ; DOS End date
S:BAREND="" BAREND=BARSTART
S BARZ=BARPAT_U_BARSTART_U_BAREND_U_+Y(0)_U_+Y
Q
; *********************************************************************
SELFRID ;
; Identifier on "Select Flate Rate Post BILL"
; Patient name from A/R bill file
S BARID1=$$VALI^XBDIQ1(90054.0103,"BARIEN,BARFIEN,Y",.01)
S BARID2=$$VAL^XBDIQ1(90050.01,BARID1,101)
W ?30,$E(BARID2,1,30)
Q
; *********************************************************************
FINDBIL ; EP
S BARASK=1
S BARCNT=$$EN^BARPST2(BARPASS) ; Count bills for DOS range
I 'BARCNT D Q ; No bills found
. W *7
. W !,"No bills found in this date range!"
I BARCNT=1 D Q ; One bill found for DOS range
. S $P(BARFPASS,U,4)=$O(^BARTMP($J,"B",BARCNT,""))
; More than one bill found for DOS range, ask user to select
D HIT^BARFPST3(BARPASS) ; List bills for DOS range
D ASKLIN Q:'+BARASK ; Ask user to select one
S $P(BARFPASS,U,4)=$O(^BARTMP($J,"B",BARLIN,"")) ; A/R Bill IEN
Q
; *********************************************************************
HIT(BARPASS) ; EP
; EP - Display A/R bills found
N BARBDA,BARLIN,BARREC,BARBLO
S (BARBDA,BARPG,BARSTOP)=0
;
; header
W $$EN^BARVDF("IOF"),! ; Clear screen
N BARPTNAM ; A/R Patient Name
S BARPG=BARPG+1 ; Page number
S BARPTNAM=$P(^DPT(+BARPASS,0),U) ; A/R Patient Name
; If A/R Patient cross-reference on A/R TRANSACTION/IHS File
I $D(^BARTR(DUZ(2),"AM5",+BARPASS)) S BARPTNAM="(msg) "_BARPTNAM
W "Claims for "_BARPTNAM
W " from "_$$SDT^BARDUTL($P(BARPASS,U,2))
W " to "_$$SDT^BARDUTL($P(BARPASS,U,3))
W ?(IOM-15),"Page: "_BARPG
W !!
W "Line #",?8,"DOS",?18,"Claim #",?32,"Amount",?44,"Billed To",?70,"Balance"
S BARDSH=""
S $P(BARDSH,"-",IOM)="" ; Line of dashes
W !,BARDSH
F S BARBDA=$O(^BARTMP($J,BARBDA)) Q:'BARBDA D Q:BARSTOP
. S BARLIN=$O(^BARTMP($J,BARBDA,""))
. S BARREC=^BARTMP($J,BARBDA,BARLIN)
. S BARBLO=$P(BARREC,U,2)
. I $O(^BARTR(DUZ(2),"AM4",+BARBLO)) S BARBLO="m "_BARBLO
. S BARSTOP=$$CHKLINE(0)
. Q:BARSTOP
. S BARCMSG=" "
. S:$P(BARREC,U,8)="3P CANCELLED" BARCMSG="3P CAN"
. W !,$J(BARLIN,3)
. W ?6,$$SDT^BARDUTL($P(BARREC,U))
. W ?18,BARBLO
. W ?25,BARCMSG
. W ?32,$J($P(BARREC,U,3),8,2)
. W ?44,$E($P(BARREC,U,4),1,23)
. W ?70,$J($P(BARREC,U,5),8,2)
Q
; *********************************************************************
CHKLINE(BARHD) ;
; Q 0 = continue
; Q 1 = stop
N X
I ($Y+5)<IOSL Q 0
W !?(IOM-15),"continued==>"
D EOP^BARUTL(0)
I 'Y Q 1
Q 0
; *********************************************************************
ASKLIN ; EP
; If entering bills by Patient or DOS, ask user to choose one
W !
K DIR
S DIR(0)="NAO^^K:X>BARCNT X"
S DIR("A")="Line #: "
S DIR("?")="Enter a number between 1 and "_BARCNT
D ^DIR
I +Y<0 S BARASK=0 Q
S BARLIN=+Y
Q
; *********************************************************************
DELBIL ;
; Ask if user wants to delete bill from A/R FLAT RATE POSTING File
K DIR
S DIR(0)="Y"
S DIR("A")="Delete"
S DIR("B")="No"
D ^DIR
K DIR
Q:Y'=1
; If the answer is yes, delete bill from A/R FLAT RATE POSTING File
K DIK
S DA(2)=BARIEN ; IEN to A/R FLAT RATE POSTING File
S DA(1)=BARFIEN ; IEN to VISIT LOC mult of A/R FRP File
S DA=$P(BARFPASS,U,5) ; IEN to A/R BILL mult of A/R FRP File
S DIK="^BARFRP(DUZ(2),DA(2),2,DA(1),3,"
D ^DIK ; Kill bill entry
S BARAPST=BARAPST-$G(BARPAY) ; Amount To Post
S BARBAL=BARPAMT-BARAPST ; Remaining Balance
W ?20,"Deleted."
W !,"Amount To Post: ",BARAPST,?30,"Remaining Balance: ",BARBAL
Q
; *********************************************************************
PAYOR ;
; If payor on bill differs from payor on account, notify user
S BARPAYOR=1
I $P(BARFPASS,U,4)="" S BARBTO="UNKNOWN" ; Payor billed
E S BARBTO=$$VALI^XBDIQ1(90050.01,$P(BARFPASS,U,4),3)
I BARBTO'=BARPDBY D Q:'+Y ; if billed to '= paid by payor
. K DIR
. S DIR("A",2)="The payor ("
. S DIR("A",2)=DIR("A",2)_$S(BARBTO="UNKNOWN":"UNKNOWN",1:$$GET1^DIQ(90050.02,BARBTO,.01))
. S DIR("A",2)=DIR("A",2)_") on the bill"
. S DIR("A",3)="does not match the Payor ("_$$GET1^DIQ(90050.02,BARPDBY,.01)_") on the item."
. S DIR("A")="Continue"
. S DIR("B")="No"
. S DIR(0)="Y"
. D ^DIR
. S:'+Y BARPAYOR=0
Q
; *********************************************************************
BILEXIST ;
; Check for bill in existing FRP Batch
N BARSTAT,BARNAME
S BARBILE=1
Q:'$D(^BARFRP(DUZ(2),"C",BARBLHLD)) ; not in file
S BARIEN2=$O(^BARFRP(DUZ(2),"C",BARBLHLD,""))
S BARSTAT=$$VALI^XBDIQ1(90054.01,BARIEN2,.13)
S BARSTAT=$S(BARSTAT="P":"POSTED",1:"UNPOSTED")
S BARNAME=$$VAL^XBDIQ1(90054.01,BARIEN2,.01)
K DIR
S DIR(0)="Y"
S DIR("A",2)="This bill already exists in the "_BARSTAT_" FRP Batch "_BARNAME
S DIR("A")="Continue"
S DIR("B")="No"
D ^DIR
S:'+Y BARBILE=0
Q
; *********************************************************************
NEGBILL ;
; If negative balance on bill
S BARBILB=1
S BARBLBAL=$$VAL^XBDIQ1(90050.01,BARBLHLD,15) ; Current balances
S BARBALH=BARBLBAL-$G(BARPAY)-$G(BARADJT)
I BARBALH<0 D ;HEAVILY MODIFIED;MRS:BAR*1.8*6 DD 4.2.5
.S BARBILB=0
.D STOP^BARFPST5("BILL",BARBALH)
Q
; *********************************************************************
SAVEBIL ;
; Save Bill to A/R FLAT RATE POSTING File
K DIC
S DA(2)=BARIEN
S DA(1)=BARFIEN
S DIC="^BARFRP(DUZ(2),DA(2),2,DA(1),3,"
S DIC(0)="L"
S DIC("P")=$P(^DD(90054.0102,30,0),U,2)
S X=$P(BARFPASS,U,4)
K DD,DO
D FILE^DICN
K DIC
Q
BARFPST3 ; IHS/SD/LSL - A/R FLAT RATE POSTING #3 ; 01/09/2009
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**1,6,10,21,23**;OCT 26, 2005
+2 QUIT
+3 ; *********************************************************************
DISP ; EP
+1 ; Display Accumulated posted amount and posting balance from
+2 ; A/R FLAT RATE POSTING File before making entries
+3 ; BARBIEN = IEN to A/R BILLS mult in VISIT LOCATION mult in FRP File
+4 ; J = Bill Counter
+5 SET (J,BARBIEN)=0
+6 FOR
SET BARBIEN=$ORDER(^BARFRP(DUZ(2),BARIEN,2,BARFIEN,3,BARBIEN))
IF '+BARBIEN
QUIT
SET J=J+1
+7 ; Amount To Post
SET BARAPST=+$GET(BARPAY)*J
+8 ; Remaining Balance
SET BARBAL=BARPAMT-BARAPST
+9 WRITE !!,"Amount To Post: ",BARAPST,?30,"Remaining Balance: ",BARBAL
+10 QUIT
+11 ; *********************************************************************
FRPBILL ; EP
+1 ; EP - Continue top-level loop logic
+2 ; Review flag (no posting)
SET BARFLAG=0
+3 ; Payor on item
SET BARPDBY=$$VALI^XBDIQ1(90051.1101,"BARCOL,BARITM",7)
+4 ; Ask A/R bills loop
FOR
DO BILLS
IF '+BARBIL
QUIT
+5 QUIT
+6 ; *********************************************************************
BILLS ;
+1 ; Loop through and enter/edit A/R Bills multiple in
+2 ; A/R FLAT RATE POSTING File
+3 ; BARFPASS = Patient^DOS Start^DOS End^A/R BILL IEN^FRP BILL IEN
+4 KILL BARPAT,BARZ
+5 ; Bill Entry Loop Flag
SET BARBIL=1
+6 ; Get bills by bill, patient, or DOS
SET BARFPASS=$$GETBIL^BARFPST3
+7 ; No bill selected; End loop
IF BARFPASS=0
SET BARBIL=0
QUIT
+8 ; Patient^DOS Start^DOS End
SET BARPASS=$PIECE(BARFPASS,U,1,3)
+9 ; If no A/R Bill IEN
+10 IF '+$PIECE(BARFPASS,U,4)
DO FINDBIL
IF 'BARCNT
QUIT
IF '+BARASK
QUIT
+11 ; The user selected a bill from ^BARFRP; Ask delete
+12 ; (Can only be done through EDIT)
+13 IF $PIECE(BARFPASS,U,5)]""
DO DELBIL
QUIT
+14 SET BARBLHLD=+$PIECE(BARFPASS,U,4)
+15 ; Bill entered already in ^BARFRP. don't add again
+16 IF $DATA(^BARFRP(DUZ(2),BARIEN,2,BARFIEN,3,"B",BARBLHLD))
Begin DoDot:1
+17 WRITE !,$$VAL^XBDIQ1(90050.01,BARBLHLD,.01)
+18 WRITE " has already been entered."
End DoDot:1
QUIT
+19 ; If payors differ, notify user
DO PAYOR
IF '+BARPAYOR
QUIT
+20 ; Check for bill in different FRP batch
DO BILEXIST
IF '+BARBILE
QUIT
+21 ;D NEGBILL Q:'+BARBILB ; Check for neg balance on bill ;MRS:BAR*1.8*10 H632
+22 ;MRS:BAR*1.8*10 H632
IF $$IHS^BARUFUT(DUZ(2))
DO NEGBILL
IF '+BARBILB
QUIT
+23 ;;;I $$IHSERA^BARUFUT(DUZ(2)) D NEGBILL Q:'+BARBILB ;P.OTT
+24 ; Display amount posted (accumulated) and remaining balance
+25 ; Amount To Post
SET BARAPST=BARAPST+$GET(BARPAY)
+26 ; Remaining Balance
SET BARBAL=BARPAMT-BARAPST
+27 WRITE !,"Amount To Post: ",BARAPST,?30,"Remaining Balance: ",BARBAL
+28 ; If posting results in negative balance, stop and send to review
+29 ;I BARBAL<0 D Q ;MRS:BAR*1.8*10 H632
+30 ;MRS:BAR*1.8*10 H632
IF $$IHS^BARUFUT(DUZ(2))
IF BARBAL<0
Begin DoDot:1
+31 ;;;I $$IHSERA^BARUFUT(DUZ(2)),BARBAL<0 D Q ;P.OTT
+32 WRITE !,"Posting this payment will result in a negative balance."
+33 SET BARAPST=BARAPST-$GET(BARPAY)
+34 SET BARBAL=BARPAMT-BARAPST
+35 SET BARBIL=0
End DoDot:1
QUIT
+36 ; Save Bill to A/R FLAT RATE POSTING file
DO SAVEBIL
+37 QUIT
+38 ; *********************************************************************
GETBIL() ; EP
+1 ; EP - Flat Rate Posting - Bill Entry
+2 ; If Editing, ask Flat Rate Posting Bill
+3 ;IHS/SD/TPF BAR*1.8*21 8/3/2011 HEAT20490
+4 ;IS SESSION STILL OPEN
IF $$NOTOPEN^BARUFUT(.DUZ,$GET(UFMSESID))
QUIT 0
+5 GOTO CONT
GETBIL2() ;EP for Calls that don't need open Cashiering Sessions
CONT ; Remarks entry: BARPRMKP
+1 ; End 1.8*21
+2 IF $GET(BARRECPQ)="E"
DO SELFRBIL^BARFPST3
IF $GET(BARZ)
QUIT BARZ
+3 ; Ask A/R BILL
DO SELBILL^BARPUTL
+4 IF $GET(BARZ)
Begin DoDot:1
+5 ; IEN to A/R IHS BILL File
SET BARBL=+Y
+6 SET $PIECE(BARZ,U,4)=BARBL
End DoDot:1
QUIT BARZ
+7 ; If bill not answered, ask patient
DO ASKPAT^BARPUTL
+8 IF $GET(BARZ)
QUIT BARZ
+9 ; If patient not answered, ask DOS
DO GETBIL^BARPUTL
+10 IF $GET(BARZ)
QUIT BARZ
+11 ; No bills entered
QUIT 0
+12 ; *********************************************************************
SELFRBIL ; EP
+1 ; EP - look up into A/R FLAT RATE POSTING File if EDIT
+2 KILL DIC
+3 ; IEN to VISIT LOC mult in A/R FRP File
SET DA(1)=BARFIEN
+4 ; IEN to A/R FLAT RATE POSTING File
SET DA(2)=BARIEN
+5 SET DIC="^BARFRP(DUZ(2),DA(2),2,DA(1),3,"
+6 SET DIC("A")="Select Flat Rate Post BILL: "
+7 SET DIC(0)="AEZMQ"
+8 ; Write patient name next to Bill number
+9 SET DIC("W")="D SELFRID^BARFPST3"
+10 DO ^DIC
+11 IF +Y<1
QUIT
+12 ; A/R patient
SET BARPAT=$PIECE(^BARBL(DUZ(2),+Y(0),1),U)
+13 ; DOS Start date
SET BARSTART=$PIECE(^BARBL(DUZ(2),+Y(0),1),U,2)
+14 ; DOS End date
SET BAREND=$PIECE(^BARBL(DUZ(2),+Y(0),1),U,3)
+15 IF BAREND=""
SET BAREND=BARSTART
+16 SET BARZ=BARPAT_U_BARSTART_U_BAREND_U_+Y(0)_U_+Y
+17 QUIT
+18 ; *********************************************************************
SELFRID ;
+1 ; Identifier on "Select Flate Rate Post BILL"
+2 ; Patient name from A/R bill file
+3 SET BARID1=$$VALI^XBDIQ1(90054.0103,"BARIEN,BARFIEN,Y",.01)
+4 SET BARID2=$$VAL^XBDIQ1(90050.01,BARID1,101)
+5 WRITE ?30,$EXTRACT(BARID2,1,30)
+6 QUIT
+7 ; *********************************************************************
FINDBIL ; EP
+1 SET BARASK=1
+2 ; Count bills for DOS range
SET BARCNT=$$EN^BARPST2(BARPASS)
+3 ; No bills found
IF 'BARCNT
Begin DoDot:1
+4 WRITE *7
+5 WRITE !,"No bills found in this date range!"
End DoDot:1
QUIT
+6 ; One bill found for DOS range
IF BARCNT=1
Begin DoDot:1
+7 SET $PIECE(BARFPASS,U,4)=$ORDER(^BARTMP($JOB,"B",BARCNT,""))
End DoDot:1
QUIT
+8 ; More than one bill found for DOS range, ask user to select
+9 ; List bills for DOS range
DO HIT^BARFPST3(BARPASS)
+10 ; Ask user to select one
DO ASKLIN
IF '+BARASK
QUIT
+11 ; A/R Bill IEN
SET $PIECE(BARFPASS,U,4)=$ORDER(^BARTMP($JOB,"B",BARLIN,""))
+12 QUIT
+13 ; *********************************************************************
HIT(BARPASS) ; EP
+1 ; EP - Display A/R bills found
+2 NEW BARBDA,BARLIN,BARREC,BARBLO
+3 SET (BARBDA,BARPG,BARSTOP)=0
+4 ;
+5 ; header
+6 ; Clear screen
WRITE $$EN^BARVDF("IOF"),!
+7 ; A/R Patient Name
NEW BARPTNAM
+8 ; Page number
SET BARPG=BARPG+1
+9 ; A/R Patient Name
SET BARPTNAM=$PIECE(^DPT(+BARPASS,0),U)
+10 ; If A/R Patient cross-reference on A/R TRANSACTION/IHS File
+11 IF $DATA(^BARTR(DUZ(2),"AM5",+BARPASS))
SET BARPTNAM="(msg) "_BARPTNAM
+12 WRITE "Claims for "_BARPTNAM
+13 WRITE " from "_$$SDT^BARDUTL($PIECE(BARPASS,U,2))
+14 WRITE " to "_$$SDT^BARDUTL($PIECE(BARPASS,U,3))
+15 WRITE ?(IOM-15),"Page: "_BARPG
+16 WRITE !!
+17 WRITE "Line #",?8,"DOS",?18,"Claim #",?32,"Amount",?44,"Billed To",?70,"Balance"
+18 SET BARDSH=""
+19 ; Line of dashes
SET $PIECE(BARDSH,"-",IOM)=""
+20 WRITE !,BARDSH
+21 FOR
SET BARBDA=$ORDER(^BARTMP($JOB,BARBDA))
IF 'BARBDA
QUIT
Begin DoDot:1
+22 SET BARLIN=$ORDER(^BARTMP($JOB,BARBDA,""))
+23 SET BARREC=^BARTMP($JOB,BARBDA,BARLIN)
+24 SET BARBLO=$PIECE(BARREC,U,2)
+25 IF $ORDER(^BARTR(DUZ(2),"AM4",+BARBLO))
SET BARBLO="m "_BARBLO
+26 SET BARSTOP=$$CHKLINE(0)
+27 IF BARSTOP
QUIT
+28 SET BARCMSG=" "
+29 IF $PIECE(BARREC,U,8)="3P CANCELLED"
SET BARCMSG="3P CAN"
+30 WRITE !,$JUSTIFY(BARLIN,3)
+31 WRITE ?6,$$SDT^BARDUTL($PIECE(BARREC,U))
+32 WRITE ?18,BARBLO
+33 WRITE ?25,BARCMSG
+34 WRITE ?32,$JUSTIFY($PIECE(BARREC,U,3),8,2)
+35 WRITE ?44,$EXTRACT($PIECE(BARREC,U,4),1,23)
+36 WRITE ?70,$JUSTIFY($PIECE(BARREC,U,5),8,2)
End DoDot:1
IF BARSTOP
QUIT
+37 QUIT
+38 ; *********************************************************************
CHKLINE(BARHD) ;
+1 ; Q 0 = continue
+2 ; Q 1 = stop
+3 NEW X
+4 IF ($Y+5)<IOSL
QUIT 0
+5 WRITE !?(IOM-15),"continued==>"
+6 DO EOP^BARUTL(0)
+7 IF 'Y
QUIT 1
+8 QUIT 0
+9 ; *********************************************************************
ASKLIN ; EP
+1 ; If entering bills by Patient or DOS, ask user to choose one
+2 WRITE !
+3 KILL DIR
+4 SET DIR(0)="NAO^^K:X>BARCNT X"
+5 SET DIR("A")="Line #: "
+6 SET DIR("?")="Enter a number between 1 and "_BARCNT
+7 DO ^DIR
+8 IF +Y<0
SET BARASK=0
QUIT
+9 SET BARLIN=+Y
+10 QUIT
+11 ; *********************************************************************
DELBIL ;
+1 ; Ask if user wants to delete bill from A/R FLAT RATE POSTING File
+2 KILL DIR
+3 SET DIR(0)="Y"
+4 SET DIR("A")="Delete"
+5 SET DIR("B")="No"
+6 DO ^DIR
+7 KILL DIR
+8 IF Y'=1
QUIT
+9 ; If the answer is yes, delete bill from A/R FLAT RATE POSTING File
+10 KILL DIK
+11 ; IEN to A/R FLAT RATE POSTING File
SET DA(2)=BARIEN
+12 ; IEN to VISIT LOC mult of A/R FRP File
SET DA(1)=BARFIEN
+13 ; IEN to A/R BILL mult of A/R FRP File
SET DA=$PIECE(BARFPASS,U,5)
+14 SET DIK="^BARFRP(DUZ(2),DA(2),2,DA(1),3,"
+15 ; Kill bill entry
DO ^DIK
+16 ; Amount To Post
SET BARAPST=BARAPST-$GET(BARPAY)
+17 ; Remaining Balance
SET BARBAL=BARPAMT-BARAPST
+18 WRITE ?20,"Deleted."
+19 WRITE !,"Amount To Post: ",BARAPST,?30,"Remaining Balance: ",BARBAL
+20 QUIT
+21 ; *********************************************************************
PAYOR ;
+1 ; If payor on bill differs from payor on account, notify user
+2 SET BARPAYOR=1
+3 ; Payor billed
IF $PIECE(BARFPASS,U,4)=""
SET BARBTO="UNKNOWN"
+4 IF '$TEST
SET BARBTO=$$VALI^XBDIQ1(90050.01,$PIECE(BARFPASS,U,4),3)
+5 ; if billed to '= paid by payor
IF BARBTO'=BARPDBY
Begin DoDot:1
+6 KILL DIR
+7 SET DIR("A",2)="The payor ("
+8 SET DIR("A",2)=DIR("A",2)_$SELECT(BARBTO="UNKNOWN":"UNKNOWN",1:$$GET1^DIQ(90050.02,BARBTO,.01))
+9 SET DIR("A",2)=DIR("A",2)_") on the bill"
+10 SET DIR("A",3)="does not match the Payor ("_$$GET1^DIQ(90050.02,BARPDBY,.01)_") on the item."
+11 SET DIR("A")="Continue"
+12 SET DIR("B")="No"
+13 SET DIR(0)="Y"
+14 DO ^DIR
+15 IF '+Y
SET BARPAYOR=0
End DoDot:1
IF '+Y
QUIT
+16 QUIT
+17 ; *********************************************************************
BILEXIST ;
+1 ; Check for bill in existing FRP Batch
+2 NEW BARSTAT,BARNAME
+3 SET BARBILE=1
+4 ; not in file
IF '$DATA(^BARFRP(DUZ(2),"C",BARBLHLD))
QUIT
+5 SET BARIEN2=$ORDER(^BARFRP(DUZ(2),"C",BARBLHLD,""))
+6 SET BARSTAT=$$VALI^XBDIQ1(90054.01,BARIEN2,.13)
+7 SET BARSTAT=$SELECT(BARSTAT="P":"POSTED",1:"UNPOSTED")
+8 SET BARNAME=$$VAL^XBDIQ1(90054.01,BARIEN2,.01)
+9 KILL DIR
+10 SET DIR(0)="Y"
+11 SET DIR("A",2)="This bill already exists in the "_BARSTAT_" FRP Batch "_BARNAME
+12 SET DIR("A")="Continue"
+13 SET DIR("B")="No"
+14 DO ^DIR
+15 IF '+Y
SET BARBILE=0
+16 QUIT
+17 ; *********************************************************************
NEGBILL ;
+1 ; If negative balance on bill
+2 SET BARBILB=1
+3 ; Current balances
SET BARBLBAL=$$VAL^XBDIQ1(90050.01,BARBLHLD,15)
+4 SET BARBALH=BARBLBAL-$GET(BARPAY)-$GET(BARADJT)
+5 ;HEAVILY MODIFIED;MRS:BAR*1.8*6 DD 4.2.5
IF BARBALH<0
Begin DoDot:1
+6 SET BARBILB=0
+7 DO STOP^BARFPST5("BILL",BARBALH)
End DoDot:1
+8 QUIT
+9 ; *********************************************************************
SAVEBIL ;
+1 ; Save Bill to A/R FLAT RATE POSTING File
+2 KILL DIC
+3 SET DA(2)=BARIEN
+4 SET DA(1)=BARFIEN
+5 SET DIC="^BARFRP(DUZ(2),DA(2),2,DA(1),3,"
+6 SET DIC(0)="L"
+7 SET DIC("P")=$PIECE(^DD(90054.0102,30,0),U,2)
+8 SET X=$PIECE(BARFPASS,U,4)
+9 KILL DD,DO
+10 DO FILE^DICN
+11 KILL DIC
+12 QUIT
