Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BARFPST3

BARFPST3.m

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