- 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