IBECEA1 ;ALB/RLW - Cancel/Edit/Add... Action Entry Points ; Sep 30, 2020@15:16:44
;;2.0;INTEGRATED BILLING;**15,27,45,176,312,663,630,784**;21-MAR-94;Build 8
;;Per VA Directive 6402, this routine should not be modified.
;
PASS ; 'Pass a Charge' Entry Action (added by Jim Moore 4/30/92)
N C,IBII,IBNOS,IBND,IBMSG,IBY,IBLINE,IBSTAT,IBAFY,IBATYP,IBHLDR,IBERROR
N IBARTYP,IBN,IBSEQNO,IBSERV,IBTOTL,IBTRAN,IBIL,IBNOS2,Y,IBXA,IBVSTIEN,IBEXCOPAY
N IBATYPE,IBBLNO,IBCDCHK,IBFR,IBMHVST,IBOEEVDT,IBOENC,IBSTOPDA,Z ; IB*2.0*784
;
S VALMBCK="R" D EN^VALM2($G(XQORNOD(0)))
I $D(VALMY) I '$$PFSSWARN^IBBSHDWN() S VALMBCK="R" Q
;
; Start of IB*2.0*630 changes
N IBDUPCPY S IBDUPCPY="" ; IB*2.0*630
S IBII="" F S IBII=$O(VALMY(IBII)) Q:'IBII D Q:IBDUPCPY
. S IBY=1,IBLINE=^TMP("IBACM",$J,IBII,0)
. S IBNOS2=+$P(^TMP("IBACMIDX",$J,IBII),"^",4)
. ; Check for duplicate copay
. S IBDUPCPY=$$DUPCPYCHK^IBECEA1(IBNOS2)
. ; If duplicate copay exists, display message
. I IBDUPCPY D Q
. . D FULL^VALM1
. . D CPYDISPLAY^IBECEA1(IBNOS2,IBDUPCPY)
. . ; Send user back to selection prompt if duplicate copays exist
. . S VALMBCK="R"
. . Q
. Q
; If duplicate was found, return user to Action list
Q:IBDUPCPY
; End of IB*2.0*630 changes
;
S IBII="" F S IBII=$O(VALMY(IBII)) Q:'IBII D L -^IB(IBNOS2) D MSG
.S IBY=1,IBLINE=^TMP("IBACM",$J,IBII,0)
.S (IBNOS,IBNOS2)=+$P(^TMP("IBACMIDX",$J,IBII),"^",4)
.;
.; - perform up-front edits
.L +^IB(IBNOS2):5 I '$T S IBMSG="was not passed - record not available, please try again" Q
.S IBND=$G(^IB(IBNOS2,0)) I IBND="" S IBMSG="was not passed - record missing the zeroth node" Q
.I $P(IBND,"^",12) S IBMSG="was not passed - the charge already has an AR Transaction Number" Q
.S IBSTAT=+$P(IBND,"^",5) I $P($G(^IBE(350.21,IBSTAT,0)),"^",4) S IBMSG="was not passed - the status indicates that the charge is billed" Q
.I $P(IBND,"^",7)'>0 S IBMSG="was not passed - there is no charge amount" Q
.S IBATYPE=+$P(IBND,U,3) ; IB*2.0*784
.S IBSEQNO=$P($G(^IBE(350.1,IBATYPE,0)),"^",5) I 'IBSEQNO S IBMSG="was not passed (Bulletin will be generated)",IBY="-1^IB023" Q ; IB*2.0*784
.I $P($G(^IBE(350.1,IBATYPE,0)),"^",11)=6 S IBMSG="was not passed - CHAMPVA charges must be cancelled and rebilled" Q ; IB*2.0*784
.S IBHLDR=(IBSTAT=21)
.; - pass charge to AR and update list
.D ^IBR S IBY=$G(Y)
.S IBND=$G(^IB(IBNOS2,0))
.S (IBSTAT,Y)=$P(IBND,"^",5),C=$P($G(^DD(350,.05,0)),"^",2) D Y^DIQ
.S IBLINE=$$SETSTR^VALM1(Y,IBLINE,+$P(VALMDDF("STATUS"),"^",2),+$P(VALMDDF("STATUS"),"^",3))
.S IBBLNO=$P(IBND,U,11) ; IB*2.0*784
.S IBLINE=$$SETSTR^VALM1($P(IBBLNO,"-",2),IBLINE,+$P(VALMDDF("BILL#"),"^",2),+$P(VALMDDF("BILL#"),"^",3)) ; IB*2.0*784
.S ^TMP("IBACM",$J,IBII,0)=IBLINE
.S IBMSG=$S(+IBY=-1:"was not passed -",IBSTAT=8:"has now been placed ON HOLD",1:"has now been passed")
.S IBFR=$P(IBND,U,14) ; IB*2.0*784
.;IB*2.0*663 If charge successfully passed, extract the bill number and update the visit tracking database if this is a CC URGENT CARE Charge
.I IBBLNO'="",$P($G(^IBE(350.1,IBATYPE,0)),U)["CC URGENT CARE" D ; IB*2.0*784
.. ; send update to the Visit Tracking file.
.. S IBVSTIEN=$$FNDVST^IBECEA4("ON HOLD",IBFR,$P(IBND,U,2)) ; IB*2.0*784
.. ;ADD THE NOT FOUND MESSAGE HERE?
.. D:+IBVSTIEN UPDATE^IBECEA38(IBVSTIEN,2,IBBLNO,"",1,.IBERROR) ; IB*2.0*784
.; IB*2.0*784
.S IBSTOPDA=$P(IBND,U,20),IBOEEVDT=$P(IBND,U,17),IBOENC=$P($P(IBND,U,4),";"),IBCDCHK=0
.I $P($G(^IBE(350.1,IBATYPE,0)),U)["CC MH" S IBCDCHK=1
.I 'IBCDCHK,$$CDCHK^IBECEAMH($$GET1^DIQ(352.5,IBSTOPDA_",",.01,"E"),IBFR) S IBCDCHK=1
.I 'IBCDCHK,$$ISCDELIG^IBECEAMH(IBFR) I $P(IBOENC,":")="409.68" S IBCDCHK=$$CHKST44^IBECEAMH($P(IBOENC,":",2))
.I 'IBCDCHK,$P(IBOENC,":")=409.68 S IBCDCHK=$$OECHK^IBECEAMH($P(IBOENC,":",2),IBOEEVDT)
.I IBBLNO'="",IBCDCHK D
..S IBMHVST=$O(^IBMH(351.83,"D",IBNOS2,"")) Q:'IBMHVST
..D MESS2B^IBECEAMH S Z=$$UPDATE^IBECEAMH(0,IBMHVST,2,IBBLNO,"",1,.IBERROR)
..Q
.;
.; - if there is no active billing clock, add one
.; added check for LTC, don't do this for LTC
.S IBXA=$P($G(^IBE(350.1,IBATYPE,0)),"^",11) ; IB*2.0*784
.I $P(IBND,"^",14),'$P($G(^IB(IBNOS2,1)),"^",5),'$D(^IBE(351,"ACT",DFN)),IBXA'=8,IBXA'=9 D
..W !,"This patient has no active billing clock. Adding a new one... "
..S IBCLDT=$P(IBND,"^",14)
..I '$D(IBSERV) D SERV^IBAUTL2
..D CLADD^IBAUTL3 W $S(IBY>0:"done.",1:"error (see msg)")
.;
.; - if charge was on hold pending review, pass data to IVM
.I IBHLDR W !,"Passing billing data to the IVM package... " D IVM^IBAMTV32(IBND) W "done."
Q
;
MSG ; Display results message.
Q:+$G(IBDUPCPY)>0 ; IB*2.0*630
W !,"Charge #"_IBII_" "_IBMSG I +IBY=-1 D ^IBAERR1
W ! S DIR(0)="E" D ^DIR K DIR W !
Q
;
;
ADD ; 'Add a Charge' Entry Action
I '$$PFSSWARN^IBBSHDWN() S VALMBCK="R" Q ;IB*2.0*312
G ^IBECEA3
;
UPD ; 'Edit a Charge' Entry Action
S IBAUPD=1
;
CAN ; 'Cancel a Charge' Entry Action
D EN^VALM2(IBNOD(0)) I '$O(VALMY(0)) S VALMBCK="" G CANQ
I $G(IBAUPD) I '$$PFSSWARN^IBBSHDWN() S VALMBCK="R" Q ;IB*2.0*312
;
S (IBNBR,IBCOMMIT)=0,VALMBCK="R"
F S IBNBR=$O(VALMY(IBNBR)) Q:'IBNBR D ^@$S($G(IBAUPD):"IBECEA2",1:"IBECEA4")
I IBCOMMIT S IBBG=VALMBG W !,"Rebuilding list of charges..." D ARRAY^IBECEA0 S VALMBG=IBBG
K IBBG,IBNBR,IBAUPD,IBCOMMIT
CANQ Q
;
PAUSE ; Keep this around for awhile.
W ! S DIR(0)="E" D ^DIR K DIR W !
Q
;
; Beginning of IB*2.0*630 changes
DUPCPYCHK(IBIENS) ;
; Input: IBIENS = A single charge IEN to release or a series of charge IENs separated by commas
; Output: 0: No Duplicate Copay exists for the patient/date
; #: IEN of the Duplicate Copay
; If the charge currently being released is a Copay charge, then check for duplicates
; All charges including ON HOLD Copay charges will be in the ACHDT x-ref
N IBARY,IBDT,IBDUPCPY,IBIEN,IBPRTY
; Initialize Copay check to 0:No duplicate copay for Patient/Date
S IBDUPCPY=0
; Prioritize charges in Y into IBARY array
D IBARY(IBIENS,.IBARY)
; Quit if no entries in IBARY
Q:'$D(IBARY) 0
; Loop through charges in IBARY by Date, Priority and IEN
S IBDT=""
F S IBDT=$O(IBARY(IBDT)) Q:IBDT="" D Q:IBDUPCPY
. S IBPRTY=""
. F S IBPRTY=$O(IBARY(IBDT,IBPRTY)) Q:'IBPRTY D Q:IBDUPCPY
. . S IBIEN=""
. . F S IBIEN=$O(IBARY(IBDT,IBPRTY,IBIEN)) Q:'IBIEN D Q:IBDUPCPY
. . . ; Check charge in IBARY against any existing charge in AR
. . . S IBDUPCPY=$$COPAYCHK^IBAUTL8(DFN,IBIEN,1)
. . . ; If a duplicate copay was found Quit
. . . Q:IBDUPCPY
. . Q
. Q
Q IBDUPCPY
;
IBARY(IBIENS,IBARY) ; Process user selection and save in IBARY ordered by priority
; IBARY will only contain the Copay related charges that need to be checked for duplicates.
; Input: Y = A single charge IEN to release or a series of charge IENs separated by commas
; IBARY = Array name passed by reference for return array.
; Output: IBARY(Date of Interest, Priority Index, IEN in "#350)=""
N IBAT,IBDATA0,IBDT,IBINDX,IBIEN
; Loop through selected IENs
F IBINDX=1:1 S IBIEN=$P(IBIENS,",",IBINDX) Q:IBIEN="" D
. S IBDATA0=$G(^IB(IBIEN,0))
. Q:IBDATA0=""
. ; Load ACTION TYPE (#.03)
. S IBAT=$P(IBDATA0,U,3)
. Q:IBAT=""
. ; Load EVENT DATE (#.17)
. S IBDT=$P(IBDATA0,U,17)
. ; If EVENT DATE not defined, use DATE BILLED FROM (#.14)
. I IBDT="" S IBAT=$P(IBDATA0,U,14)
. Q:IBDT=""
. ; Check prioritization Billing Group #1
. I IBAT=130 S IBARY(IBDT,1,IBIEN)="" Q
. ; Billing Group #2
. I "^16^17^18^19^20^21^22^23^24^"[("^"_IBAT_"^") D Q
. . S IBARY(IBDT,2,IBIEN)=""
. ; Billing Group #3
. I "^45^48^133^"[("^"_IBAT_"^") D Q
. . S IBARY(IBDT,3,IBIEN)=""
. ; Billing Group #4 - Outpatient Observation Copays have precedence over other copays in Billing Group #3
. I IBAT=74 S IBARY(IBDT,4,IBIEN)="" Q
. ; Billing Group #4 - Everything but Outpatient Observation Copays
. I "^51^136^203^"[("^"_IBAT_"^") D Q
. . S IBARY(IBDT,5,IBIEN)=""
. ; Billing Group #8
. I "^89^92^95^105^108^"[("^"_IBAT_"^") D Q
. . S IBARY(IBDT,6,IBIEN)=""
Q
;
GETINFO(IBIEN) ; Display Duplicate Copay info to the user.
; IBIEN = Existing Copay already charged for Patient/Date
N IBBIL,IBCSTOP,IBDATE,IBTCH,IBTEXT,IBTRN,IBATYP
; Get data in External format for charge being passed to AR
S IBATYP=$$GET1^DIQ(350,IBIEN_",",".03","E") ; ACTION TYPE
S IBATYP=$E(IBATYP,1,25)
S IBTCH=$$GET1^DIQ(350,IBIEN_",",".07","E") ; TOTAL CHARGE
S IBBIL=$$GET1^DIQ(350,IBIEN_",",".11","E") ; AR BILL NUMBER
S IBTRN=$$GET1^DIQ(350,IBIEN_",",".12","E") ; AR TRANSACTION NUMBER
S IBCSTOP=$$GET1^DIQ(350,IBIEN_",",".2","E") ; CLINIC STOP
S IBCSTOP=$J(IBCSTOP,3)
S IBDATE=$$GET1^DIQ(350,IBIEN_",",".17","I") ; EVENT DATE
I IBDATE="" S IBDATE=$$GET1^DIQ(350,IBIEN_",",".14","I") ; DATE BILLED FROM
S IBDATE=$$FMTE^XLFDT(IBDATE,"2Z")
S IBTEXT=IBDATE,$E(IBTEXT,10)=" "
S IBTEXT=IBTEXT_IBATYP,$E(IBTEXT,37)=" "
S IBTEXT=IBTEXT_IBCSTOP,$E(IBTEXT,44)="$"
S IBTEXT=IBTEXT_$J(IBTCH,9,2),$E(IBTEXT,55)=" "
S IBTEXT=IBTEXT_IBBIL,$E(IBTEXT,69)=" "
S IBTEXT=IBTEXT_IBTRN
Q IBTEXT
;
CPYDISPLAY(IBIEN1,IBIEN2) ; Display Duplicate Copay info to the user.
; Input: IBIEN1 - IEN of 1st charge - Currently in IB
; IBIEN2 - IEN of 2nd charge - Could be in IB or AR
;
; Output: Info related to the duplicate charges
;
Q:IBIEN1=""!(IBIEN2="")
; Get info to display
N IBFLAG,IBTEXT1,IBTEXT2,IBTEXT3,IBTRANS
S IBTEXT1=$$GETINFO^IBECEA1(IBIEN1)
S IBTEXT2=$$GETINFO^IBECEA1(IBIEN2)
S IBTEXT3=""
; Load AR TRANSACTION NUMBER of Duplicate Copay found
S IBTRANS=$$GET1^DIQ(350,IBIEN2_",",".12","I")
S IBFLAG=+IBTRANS
; For Inpatient copays, check for an existing Outpatient Observation copays
; and display that info if it exists.
I $P(IBIEN2,U,2) S IBTEXT3=$$GETINFO^IBECEA1($P(IBIEN2,U,2))
;
W !
; Display message if both charges are only in IB
I 'IBFLAG D
. W !,"There are ",$S(IBTEXT3'="":"three ",1:"two "),"On Hold copay charges in the selection you made for the same"
. W !,"patient/date."
. I IBTEXT3'="" D
. . W !,"Also check the following Outpatient Observation charge."
. W !!,"Date Charge Type Stop Charge"
;
; Display message if the duplicate charge has already been passed AR
I IBFLAG D
. W !,"There are ",$S(IBTEXT3'="":"three ",1:"two "),"copay charges for this Patient/Date."
. W !,"The first charge is currently On Hold, the second charge has already been"
. W !,"passed to AR:"
. I IBTEXT3'="" D
. . W !,"Also check the following Outpatient Observation charge."
. W !!,"Date Charge Type Stop Charge Bill Transaction"
;
; Display info for the charges
W !,"================================================================================"
W !,IBTEXT1
W !,IBTEXT2
I IBTEXT3'="" W !,IBTEXT3
;
W !!,"Please review these charges and determine what action(s) should be taken."
D PAUSE
Q
; End of IB*2.0*630 changes
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBECEA1 11097 printed Oct 16, 2024@18:21:51 Page 2
IBECEA1 ;ALB/RLW - Cancel/Edit/Add... Action Entry Points ; Sep 30, 2020@15:16:44
+1 ;;2.0;INTEGRATED BILLING;**15,27,45,176,312,663,630,784**;21-MAR-94;Build 8
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
PASS ; 'Pass a Charge' Entry Action (added by Jim Moore 4/30/92)
+1 NEW C,IBII,IBNOS,IBND,IBMSG,IBY,IBLINE,IBSTAT,IBAFY,IBATYP,IBHLDR,IBERROR
+2 NEW IBARTYP,IBN,IBSEQNO,IBSERV,IBTOTL,IBTRAN,IBIL,IBNOS2,Y,IBXA,IBVSTIEN,IBEXCOPAY
+3 ; IB*2.0*784
NEW IBATYPE,IBBLNO,IBCDCHK,IBFR,IBMHVST,IBOEEVDT,IBOENC,IBSTOPDA,Z
+4 ;
+5 SET VALMBCK="R"
DO EN^VALM2($GET(XQORNOD(0)))
+6 IF $DATA(VALMY)
IF '$$PFSSWARN^IBBSHDWN()
SET VALMBCK="R"
QUIT
+7 ;
+8 ; Start of IB*2.0*630 changes
+9 ; IB*2.0*630
NEW IBDUPCPY
SET IBDUPCPY=""
+10 SET IBII=""
FOR
SET IBII=$ORDER(VALMY(IBII))
if 'IBII
QUIT
Begin DoDot:1
+11 SET IBY=1
SET IBLINE=^TMP("IBACM",$JOB,IBII,0)
+12 SET IBNOS2=+$PIECE(^TMP("IBACMIDX",$JOB,IBII),"^",4)
+13 ; Check for duplicate copay
+14 SET IBDUPCPY=$$DUPCPYCHK^IBECEA1(IBNOS2)
+15 ; If duplicate copay exists, display message
+16 IF IBDUPCPY
Begin DoDot:2
+17 DO FULL^VALM1
+18 DO CPYDISPLAY^IBECEA1(IBNOS2,IBDUPCPY)
+19 ; Send user back to selection prompt if duplicate copays exist
+20 SET VALMBCK="R"
+21 QUIT
End DoDot:2
QUIT
+22 QUIT
End DoDot:1
if IBDUPCPY
QUIT
+23 ; If duplicate was found, return user to Action list
+24 if IBDUPCPY
QUIT
+25 ; End of IB*2.0*630 changes
+26 ;
+27 SET IBII=""
FOR
SET IBII=$ORDER(VALMY(IBII))
if 'IBII
QUIT
Begin DoDot:1
+28 SET IBY=1
SET IBLINE=^TMP("IBACM",$JOB,IBII,0)
+29 SET (IBNOS,IBNOS2)=+$PIECE(^TMP("IBACMIDX",$JOB,IBII),"^",4)
+30 ;
+31 ; - perform up-front edits
+32 LOCK +^IB(IBNOS2):5
IF '$TEST
SET IBMSG="was not passed - record not available, please try again"
QUIT
+33 SET IBND=$GET(^IB(IBNOS2,0))
IF IBND=""
SET IBMSG="was not passed - record missing the zeroth node"
QUIT
+34 IF $PIECE(IBND,"^",12)
SET IBMSG="was not passed - the charge already has an AR Transaction Number"
QUIT
+35 SET IBSTAT=+$PIECE(IBND,"^",5)
IF $PIECE($GET(^IBE(350.21,IBSTAT,0)),"^",4)
SET IBMSG="was not passed - the status indicates that the charge is billed"
QUIT
+36 IF $PIECE(IBND,"^",7)'>0
SET IBMSG="was not passed - there is no charge amount"
QUIT
+37 ; IB*2.0*784
SET IBATYPE=+$PIECE(IBND,U,3)
+38 ; IB*2.0*784
SET IBSEQNO=$PIECE($GET(^IBE(350.1,IBATYPE,0)),"^",5)
IF 'IBSEQNO
SET IBMSG="was not passed (Bulletin will be generated)"
SET IBY="-1^IB023"
QUIT
+39 ; IB*2.0*784
IF $PIECE($GET(^IBE(350.1,IBATYPE,0)),"^",11)=6
SET IBMSG="was not passed - CHAMPVA charges must be cancelled and rebilled"
QUIT
+40 SET IBHLDR=(IBSTAT=21)
+41 ; - pass charge to AR and update list
+42 DO ^IBR
SET IBY=$GET(Y)
+43 SET IBND=$GET(^IB(IBNOS2,0))
+44 SET (IBSTAT,Y)=$PIECE(IBND,"^",5)
SET C=$PIECE($GET(^DD(350,.05,0)),"^",2)
DO Y^DIQ
+45 SET IBLINE=$$SETSTR^VALM1(Y,IBLINE,+$PIECE(VALMDDF("STATUS"),"^",2),+$PIECE(VALMDDF("STATUS"),"^",3))
+46 ; IB*2.0*784
SET IBBLNO=$PIECE(IBND,U,11)
+47 ; IB*2.0*784
SET IBLINE=$$SETSTR^VALM1($PIECE(IBBLNO,"-",2),IBLINE,+$PIECE(VALMDDF("BILL#"),"^",2),+$PIECE(VALMDDF("BILL#"),"^",3))
+48 SET ^TMP("IBACM",$JOB,IBII,0)=IBLINE
+49 SET IBMSG=$SELECT(+IBY=-1:"was not passed -",IBSTAT=8:"has now been placed ON HOLD",1:"has now been passed")
+50 ; IB*2.0*784
SET IBFR=$PIECE(IBND,U,14)
+51 ;IB*2.0*663 If charge successfully passed, extract the bill number and update the visit tracking database if this is a CC URGENT CARE Charge
+52 ; IB*2.0*784
IF IBBLNO'=""
IF $PIECE($GET(^IBE(350.1,IBATYPE,0)),U)["CC URGENT CARE"
Begin DoDot:2
+53 ; send update to the Visit Tracking file.
+54 ; IB*2.0*784
SET IBVSTIEN=$$FNDVST^IBECEA4("ON HOLD",IBFR,$PIECE(IBND,U,2))
+55 ;ADD THE NOT FOUND MESSAGE HERE?
+56 ; IB*2.0*784
if +IBVSTIEN
DO UPDATE^IBECEA38(IBVSTIEN,2,IBBLNO,"",1,.IBERROR)
End DoDot:2
+57 ; IB*2.0*784
+58 SET IBSTOPDA=$PIECE(IBND,U,20)
SET IBOEEVDT=$PIECE(IBND,U,17)
SET IBOENC=$PIECE($PIECE(IBND,U,4),";")
SET IBCDCHK=0
+59 IF $PIECE($GET(^IBE(350.1,IBATYPE,0)),U)["CC MH"
SET IBCDCHK=1
+60 IF 'IBCDCHK
IF $$CDCHK^IBECEAMH($$GET1^DIQ(352.5,IBSTOPDA_",",.01,"E"),IBFR)
SET IBCDCHK=1
+61 IF 'IBCDCHK
IF $$ISCDELIG^IBECEAMH(IBFR)
IF $PIECE(IBOENC,":")="409.68"
SET IBCDCHK=$$CHKST44^IBECEAMH($PIECE(IBOENC,":",2))
+62 IF 'IBCDCHK
IF $PIECE(IBOENC,":")=409.68
SET IBCDCHK=$$OECHK^IBECEAMH($PIECE(IBOENC,":",2),IBOEEVDT)
+63 IF IBBLNO'=""
IF IBCDCHK
Begin DoDot:2
+64 SET IBMHVST=$ORDER(^IBMH(351.83,"D",IBNOS2,""))
if 'IBMHVST
QUIT
+65 DO MESS2B^IBECEAMH
SET Z=$$UPDATE^IBECEAMH(0,IBMHVST,2,IBBLNO,"",1,.IBERROR)
+66 QUIT
End DoDot:2
+67 ;
+68 ; - if there is no active billing clock, add one
+69 ; added check for LTC, don't do this for LTC
+70 ; IB*2.0*784
SET IBXA=$PIECE($GET(^IBE(350.1,IBATYPE,0)),"^",11)
+71 IF $PIECE(IBND,"^",14)
IF '$PIECE($GET(^IB(IBNOS2,1)),"^",5)
IF '$DATA(^IBE(351,"ACT",DFN))
IF IBXA'=8
IF IBXA'=9
Begin DoDot:2
+72 WRITE !,"This patient has no active billing clock. Adding a new one... "
+73 SET IBCLDT=$PIECE(IBND,"^",14)
+74 IF '$DATA(IBSERV)
DO SERV^IBAUTL2
+75 DO CLADD^IBAUTL3
WRITE $SELECT(IBY>0:"done.",1:"error (see msg)")
End DoDot:2
+76 ;
+77 ; - if charge was on hold pending review, pass data to IVM
+78 IF IBHLDR
WRITE !,"Passing billing data to the IVM package... "
DO IVM^IBAMTV32(IBND)
WRITE "done."
End DoDot:1
LOCK -^IB(IBNOS2)
DO MSG
+79 QUIT
+80 ;
MSG ; Display results message.
+1 ; IB*2.0*630
if +$GET(IBDUPCPY)>0
QUIT
+2 WRITE !,"Charge #"_IBII_" "_IBMSG
IF +IBY=-1
DO ^IBAERR1
+3 WRITE !
SET DIR(0)="E"
DO ^DIR
KILL DIR
WRITE !
+4 QUIT
+5 ;
+6 ;
ADD ; 'Add a Charge' Entry Action
+1 ;IB*2.0*312
IF '$$PFSSWARN^IBBSHDWN()
SET VALMBCK="R"
QUIT
+2 GOTO ^IBECEA3
+3 ;
UPD ; 'Edit a Charge' Entry Action
+1 SET IBAUPD=1
+2 ;
CAN ; 'Cancel a Charge' Entry Action
+1 DO EN^VALM2(IBNOD(0))
IF '$ORDER(VALMY(0))
SET VALMBCK=""
GOTO CANQ
+2 ;IB*2.0*312
IF $GET(IBAUPD)
IF '$$PFSSWARN^IBBSHDWN()
SET VALMBCK="R"
QUIT
+3 ;
+4 SET (IBNBR,IBCOMMIT)=0
SET VALMBCK="R"
+5 FOR
SET IBNBR=$ORDER(VALMY(IBNBR))
if 'IBNBR
QUIT
DO ^@$SELECT($GET(IBAUPD):"IBECEA2",1:"IBECEA4")
+6 IF IBCOMMIT
SET IBBG=VALMBG
WRITE !,"Rebuilding list of charges..."
DO ARRAY^IBECEA0
SET VALMBG=IBBG
+7 KILL IBBG,IBNBR,IBAUPD,IBCOMMIT
CANQ QUIT
+1 ;
PAUSE ; Keep this around for awhile.
+1 WRITE !
SET DIR(0)="E"
DO ^DIR
KILL DIR
WRITE !
+2 QUIT
+3 ;
+4 ; Beginning of IB*2.0*630 changes
DUPCPYCHK(IBIENS) ;
+1 ; Input: IBIENS = A single charge IEN to release or a series of charge IENs separated by commas
+2 ; Output: 0: No Duplicate Copay exists for the patient/date
+3 ; #: IEN of the Duplicate Copay
+4 ; If the charge currently being released is a Copay charge, then check for duplicates
+5 ; All charges including ON HOLD Copay charges will be in the ACHDT x-ref
+6 NEW IBARY,IBDT,IBDUPCPY,IBIEN,IBPRTY
+7 ; Initialize Copay check to 0:No duplicate copay for Patient/Date
+8 SET IBDUPCPY=0
+9 ; Prioritize charges in Y into IBARY array
+10 DO IBARY(IBIENS,.IBARY)
+11 ; Quit if no entries in IBARY
+12 if '$DATA(IBARY)
QUIT 0
+13 ; Loop through charges in IBARY by Date, Priority and IEN
+14 SET IBDT=""
+15 FOR
SET IBDT=$ORDER(IBARY(IBDT))
if IBDT=""
QUIT
Begin DoDot:1
+16 SET IBPRTY=""
+17 FOR
SET IBPRTY=$ORDER(IBARY(IBDT,IBPRTY))
if 'IBPRTY
QUIT
Begin DoDot:2
+18 SET IBIEN=""
+19 FOR
SET IBIEN=$ORDER(IBARY(IBDT,IBPRTY,IBIEN))
if 'IBIEN
QUIT
Begin DoDot:3
+20 ; Check charge in IBARY against any existing charge in AR
+21 SET IBDUPCPY=$$COPAYCHK^IBAUTL8(DFN,IBIEN,1)
+22 ; If a duplicate copay was found Quit
+23 if IBDUPCPY
QUIT
End DoDot:3
if IBDUPCPY
QUIT
+24 QUIT
End DoDot:2
if IBDUPCPY
QUIT
+25 QUIT
End DoDot:1
if IBDUPCPY
QUIT
+26 QUIT IBDUPCPY
+27 ;
IBARY(IBIENS,IBARY) ; Process user selection and save in IBARY ordered by priority
+1 ; IBARY will only contain the Copay related charges that need to be checked for duplicates.
+2 ; Input: Y = A single charge IEN to release or a series of charge IENs separated by commas
+3 ; IBARY = Array name passed by reference for return array.
+4 ; Output: IBARY(Date of Interest, Priority Index, IEN in "#350)=""
+5 NEW IBAT,IBDATA0,IBDT,IBINDX,IBIEN
+6 ; Loop through selected IENs
+7 FOR IBINDX=1:1
SET IBIEN=$PIECE(IBIENS,",",IBINDX)
if IBIEN=""
QUIT
Begin DoDot:1
+8 SET IBDATA0=$GET(^IB(IBIEN,0))
+9 if IBDATA0=""
QUIT
+10 ; Load ACTION TYPE (#.03)
+11 SET IBAT=$PIECE(IBDATA0,U,3)
+12 if IBAT=""
QUIT
+13 ; Load EVENT DATE (#.17)
+14 SET IBDT=$PIECE(IBDATA0,U,17)
+15 ; If EVENT DATE not defined, use DATE BILLED FROM (#.14)
+16 IF IBDT=""
SET IBAT=$PIECE(IBDATA0,U,14)
+17 if IBDT=""
QUIT
+18 ; Check prioritization Billing Group #1
+19 IF IBAT=130
SET IBARY(IBDT,1,IBIEN)=""
QUIT
+20 ; Billing Group #2
+21 IF "^16^17^18^19^20^21^22^23^24^"[("^"_IBAT_"^")
Begin DoDot:2
+22 SET IBARY(IBDT,2,IBIEN)=""
End DoDot:2
QUIT
+23 ; Billing Group #3
+24 IF "^45^48^133^"[("^"_IBAT_"^")
Begin DoDot:2
+25 SET IBARY(IBDT,3,IBIEN)=""
End DoDot:2
QUIT
+26 ; Billing Group #4 - Outpatient Observation Copays have precedence over other copays in Billing Group #3
+27 IF IBAT=74
SET IBARY(IBDT,4,IBIEN)=""
QUIT
+28 ; Billing Group #4 - Everything but Outpatient Observation Copays
+29 IF "^51^136^203^"[("^"_IBAT_"^")
Begin DoDot:2
+30 SET IBARY(IBDT,5,IBIEN)=""
End DoDot:2
QUIT
+31 ; Billing Group #8
+32 IF "^89^92^95^105^108^"[("^"_IBAT_"^")
Begin DoDot:2
+33 SET IBARY(IBDT,6,IBIEN)=""
End DoDot:2
QUIT
End DoDot:1
+34 QUIT
+35 ;
GETINFO(IBIEN) ; Display Duplicate Copay info to the user.
+1 ; IBIEN = Existing Copay already charged for Patient/Date
+2 NEW IBBIL,IBCSTOP,IBDATE,IBTCH,IBTEXT,IBTRN,IBATYP
+3 ; Get data in External format for charge being passed to AR
+4 ; ACTION TYPE
SET IBATYP=$$GET1^DIQ(350,IBIEN_",",".03","E")
+5 SET IBATYP=$EXTRACT(IBATYP,1,25)
+6 ; TOTAL CHARGE
SET IBTCH=$$GET1^DIQ(350,IBIEN_",",".07","E")
+7 ; AR BILL NUMBER
SET IBBIL=$$GET1^DIQ(350,IBIEN_",",".11","E")
+8 ; AR TRANSACTION NUMBER
SET IBTRN=$$GET1^DIQ(350,IBIEN_",",".12","E")
+9 ; CLINIC STOP
SET IBCSTOP=$$GET1^DIQ(350,IBIEN_",",".2","E")
+10 SET IBCSTOP=$JUSTIFY(IBCSTOP,3)
+11 ; EVENT DATE
SET IBDATE=$$GET1^DIQ(350,IBIEN_",",".17","I")
+12 ; DATE BILLED FROM
IF IBDATE=""
SET IBDATE=$$GET1^DIQ(350,IBIEN_",",".14","I")
+13 SET IBDATE=$$FMTE^XLFDT(IBDATE,"2Z")
+14 SET IBTEXT=IBDATE
SET $EXTRACT(IBTEXT,10)=" "
+15 SET IBTEXT=IBTEXT_IBATYP
SET $EXTRACT(IBTEXT,37)=" "
+16 SET IBTEXT=IBTEXT_IBCSTOP
SET $EXTRACT(IBTEXT,44)="$"
+17 SET IBTEXT=IBTEXT_$JUSTIFY(IBTCH,9,2)
SET $EXTRACT(IBTEXT,55)=" "
+18 SET IBTEXT=IBTEXT_IBBIL
SET $EXTRACT(IBTEXT,69)=" "
+19 SET IBTEXT=IBTEXT_IBTRN
+20 QUIT IBTEXT
+21 ;
CPYDISPLAY(IBIEN1,IBIEN2) ; Display Duplicate Copay info to the user.
+1 ; Input: IBIEN1 - IEN of 1st charge - Currently in IB
+2 ; IBIEN2 - IEN of 2nd charge - Could be in IB or AR
+3 ;
+4 ; Output: Info related to the duplicate charges
+5 ;
+6 if IBIEN1=""!(IBIEN2="")
QUIT
+7 ; Get info to display
+8 NEW IBFLAG,IBTEXT1,IBTEXT2,IBTEXT3,IBTRANS
+9 SET IBTEXT1=$$GETINFO^IBECEA1(IBIEN1)
+10 SET IBTEXT2=$$GETINFO^IBECEA1(IBIEN2)
+11 SET IBTEXT3=""
+12 ; Load AR TRANSACTION NUMBER of Duplicate Copay found
+13 SET IBTRANS=$$GET1^DIQ(350,IBIEN2_",",".12","I")
+14 SET IBFLAG=+IBTRANS
+15 ; For Inpatient copays, check for an existing Outpatient Observation copays
+16 ; and display that info if it exists.
+17 IF $PIECE(IBIEN2,U,2)
SET IBTEXT3=$$GETINFO^IBECEA1($PIECE(IBIEN2,U,2))
+18 ;
+19 WRITE !
+20 ; Display message if both charges are only in IB
+21 IF 'IBFLAG
Begin DoDot:1
+22 WRITE !,"There are ",$SELECT(IBTEXT3'="":"three ",1:"two "),"On Hold copay charges in the selection you made for the same"
+23 WRITE !,"patient/date."
+24 IF IBTEXT3'=""
Begin DoDot:2
+25 WRITE !,"Also check the following Outpatient Observation charge."
End DoDot:2
+26 WRITE !!,"Date Charge Type Stop Charge"
End DoDot:1
+27 ;
+28 ; Display message if the duplicate charge has already been passed AR
+29 IF IBFLAG
Begin DoDot:1
+30 WRITE !,"There are ",$SELECT(IBTEXT3'="":"three ",1:"two "),"copay charges for this Patient/Date."
+31 WRITE !,"The first charge is currently On Hold, the second charge has already been"
+32 WRITE !,"passed to AR:"
+33 IF IBTEXT3'=""
Begin DoDot:2
+34 WRITE !,"Also check the following Outpatient Observation charge."
End DoDot:2
+35 WRITE !!,"Date Charge Type Stop Charge Bill Transaction"
End DoDot:1
+36 ;
+37 ; Display info for the charges
+38 WRITE !,"================================================================================"
+39 WRITE !,IBTEXT1
+40 WRITE !,IBTEXT2
+41 IF IBTEXT3'=""
WRITE !,IBTEXT3
+42 ;
+43 WRITE !!,"Please review these charges and determine what action(s) should be taken."
+44 DO PAUSE
+45 QUIT
+46 ; End of IB*2.0*630 changes
