- IBECEAU3 ;ALB/CPM - Cancel/Edit/Add... Add New IB Action; 11-MAR-93
- ;;2.0;INTEGRATED BILLING;**132,150,167,183,341,563,618,656,663,653,682**;21-MAR-94;Build 15
- ;;Per VA Directive 6402, this routine should not be modified.
- ;
- ADD ; Add a new Integrated Billing Action entry.
- ; Input: DFN -- Pointer to patient in file #2
- ; IBATYP -- Pointer to Action Type in file #350.1
- ; IBUNIT -- Number of units of charge
- ; IBCHG -- Total charge
- ; IBDESC -- Charge description
- ; IBSITE -- Pointer to the facility in file #4
- ; IBFAC -- Facility number
- ; IBFR -- Bill From date
- ; IBTO -- Bill To date
- ; IBEFDT -- Bill Effective Date [OPTIONAL Rx Only]
- ; IBSL -- Softlink [OPTIONAL]
- ; IBPARNT -- Pointer to parent entry in #350 [OPTIONAL]
- ; IBEVDA -- Pointer to parent event in #350 [OPTIONAL], or
- ; -- "*" to set ibevda=ibn
- ; IBEVDT -- Event Date [OPTIONAL]
- ; IBIL -- Bill Number [OPTIONAL]
- ; IBCRES -- Pointer to canc. reason in #350.3 [OPTIONAL]
- ; IBXA -- IB Action billing group [OPTIONAL]
- ; IBJOB -- Option being executed [OPTIONAL]
- ; IBCVA -- CHAMPVA Admission date [OPTIONAL]
- ; IBSTOPDA -- Pointer to clinic stop entry in #352.5 [OPTIONAL]
- ; (used for new outpatient appts created in IB)
- ; IBGMTR -- GMT Related flag [OPTIONAL]
- ; IBTIER -- Copay Tier [OPTIONAL]
- ;
- ; Output: IBN -- Internal number of new entry in file #350
- ;
- N DA,DIK,IBASTR,IBND,Y
- D ADD^IBAUTL I Y<1 S IBY=Y G ADDQ
- S:$G(IBEVDA)="*" IBEVDA=IBN
- S:$G(IBEVDA)="" IBEVDA=IBN ;check for the NULL scenario IB*2.0*656
- S IBND=DFN_"^"_IBATYP_"^"_$S($G(IBSL):IBSL,1:"350:"_IBN)_"^1^"_IBUNIT_"^"_IBCHG_"^"_IBDESC_"^"_$S($D(IBPARNT):IBPARNT,1:IBN)_"^"_$G(IBCRES)_"^"_$G(IBIL)_"^^"_IBFAC
- I IBDESC["RX COPAY",$D(IBAM) S $P(IBND,"^",18)=IBAM,$P(^IBAM(354.71,IBAM,0),"^",6)="350:"_IBN ; mark 354.71 entry back and forth
- I IBDESC["RX COPAY",$G(IBEFDT) S $P(IBND,"^",13,14)=IBEFDT_"^"_IBEFDT
- I IBDESC'["RX COPAY" S IBND=IBND_"^"_IBFR_"^"_IBTO_"^"_$G(IBEVDA)_$S($G(IBEVDT):"^"_IBEVDT,$G(IBXA)=1!($G(IBXA)=4)!($G(IBJOB)=5):"^"_IBFR,1:"")
- I $G(IBSTOPDA) S $P(IBND,"^",19)=IBSTOPDA
- I $G(IBTIER) S $P(IBND,"^",21)=IBTIER
- S $P(^IB(IBN,0),"^",2,20)=IBND
- ; IB*2.0*618 Allow Event date to File for Community Care RX
- ; IB*2.0*656 Correct a potential Undefined error
- I IBDESC["RX COPAY",$G(IBEVDT) D
- . N DIE,DR,DTOUT
- . S DA=IBN,DIE="^IB("
- . S DR=".16///"_$G(IBEVDA)_";.17///"_IBEVDT ;IB*2.0*656
- . D ^DIE
- ; end IB*2.0*618
- ;
- I $G(IBGMTR) S $P(^IB(IBN,0),"^",21)=1 ; GMT Related
- ; DUZ may be null if this code is called by a process started by an HL7 multi-threaded listener
- ; if this condition occurs the approved fix is to use the Postmaster IEN. 2/27/06, IB*2.0*341
- D NOW^%DTC S $P(^IB(IBN,1),"^")=$S(DUZ:DUZ,1:.5),$P(^(1),"^",3,5)=$S(DUZ:DUZ,1:.5)_"^"_%_$S($G(IBCVA):"^"_IBCVA,1:"")
- S DIK="^IB(",DA=IBN D IX1^DIK
- ADDQ Q
- ;
- CTBB ; Charge to be billed
- ; Check Outpat. Fee Service less than 20% Outpat Co Pay
- S:$G(IBREBILL("CHRGAMT"))'="" IBCHG=IBREBILL("CHRGAMT") ; IB*2.0*682
- D:$G(IBAFEE) FEE^IBECEAU5 Q:IBY<1
- I $G(IBDESC)["RX COPAY",$$CHKHRFS^IBAMTS3(DFN,$G(IBEFDT)) S IBCHG=IBUNIT*2 ;IB*2.0*653 charge $2.00 per unit ( 1 Unit = 30 day supply), no Tier rates.
- W !!,"Charge to be billed --> $",$J(IBCHG,0,2)
- Q
- ;
- NODED ; Could not determine the Medicare Deductible amount.
- W !,*7,"The Medicare Deductible Amount for ",$$DAT1^IBOUTL(IBCLDT)," could not be determined."
- W !,"You should determine the cause of this problem before proceeding."
- S IBY=-1
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBECEAU3 3849 printed Feb 18, 2025@23:47:56 Page 2
- IBECEAU3 ;ALB/CPM - Cancel/Edit/Add... Add New IB Action; 11-MAR-93
- +1 ;;2.0;INTEGRATED BILLING;**132,150,167,183,341,563,618,656,663,653,682**;21-MAR-94;Build 15
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- ADD ; Add a new Integrated Billing Action entry.
- +1 ; Input: DFN -- Pointer to patient in file #2
- +2 ; IBATYP -- Pointer to Action Type in file #350.1
- +3 ; IBUNIT -- Number of units of charge
- +4 ; IBCHG -- Total charge
- +5 ; IBDESC -- Charge description
- +6 ; IBSITE -- Pointer to the facility in file #4
- +7 ; IBFAC -- Facility number
- +8 ; IBFR -- Bill From date
- +9 ; IBTO -- Bill To date
- +10 ; IBEFDT -- Bill Effective Date [OPTIONAL Rx Only]
- +11 ; IBSL -- Softlink [OPTIONAL]
- +12 ; IBPARNT -- Pointer to parent entry in #350 [OPTIONAL]
- +13 ; IBEVDA -- Pointer to parent event in #350 [OPTIONAL], or
- +14 ; -- "*" to set ibevda=ibn
- +15 ; IBEVDT -- Event Date [OPTIONAL]
- +16 ; IBIL -- Bill Number [OPTIONAL]
- +17 ; IBCRES -- Pointer to canc. reason in #350.3 [OPTIONAL]
- +18 ; IBXA -- IB Action billing group [OPTIONAL]
- +19 ; IBJOB -- Option being executed [OPTIONAL]
- +20 ; IBCVA -- CHAMPVA Admission date [OPTIONAL]
- +21 ; IBSTOPDA -- Pointer to clinic stop entry in #352.5 [OPTIONAL]
- +22 ; (used for new outpatient appts created in IB)
- +23 ; IBGMTR -- GMT Related flag [OPTIONAL]
- +24 ; IBTIER -- Copay Tier [OPTIONAL]
- +25 ;
- +26 ; Output: IBN -- Internal number of new entry in file #350
- +27 ;
- +28 NEW DA,DIK,IBASTR,IBND,Y
- +29 DO ADD^IBAUTL
- IF Y<1
- SET IBY=Y
- GOTO ADDQ
- +30 if $GET(IBEVDA)="*"
- SET IBEVDA=IBN
- +31 ;check for the NULL scenario IB*2.0*656
- if $GET(IBEVDA)=""
- SET IBEVDA=IBN
- +32 SET IBND=DFN_"^"_IBATYP_"^"_$SELECT($GET(IBSL):IBSL,1:"350:"_IBN)_"^1^"_IBUNIT_"^"_IBCHG_"^"_IBDESC_"^"_$SELECT($DATA(IBPARNT):IBPARNT,1:IBN)_"^"_$GET(IBCRES)_"^"_$GET(IBIL)_"^^"_IBFAC
- +33 ; mark 354.71 entry back and forth
- IF IBDESC["RX COPAY"
- IF $DATA(IBAM)
- SET $PIECE(IBND,"^",18)=IBAM
- SET $PIECE(^IBAM(354.71,IBAM,0),"^",6)="350:"_IBN
- +34 IF IBDESC["RX COPAY"
- IF $GET(IBEFDT)
- SET $PIECE(IBND,"^",13,14)=IBEFDT_"^"_IBEFDT
- +35 IF IBDESC'["RX COPAY"
- SET IBND=IBND_"^"_IBFR_"^"_IBTO_"^"_$GET(IBEVDA)_$SELECT($GET(IBEVDT):"^"_IBEVDT,$GET(IBXA)=1!($GET(IBXA)=4)!($GET(IBJOB)=5):"^"_IBFR,1:"")
- +36 IF $GET(IBSTOPDA)
- SET $PIECE(IBND,"^",19)=IBSTOPDA
- +37 IF $GET(IBTIER)
- SET $PIECE(IBND,"^",21)=IBTIER
- +38 SET $PIECE(^IB(IBN,0),"^",2,20)=IBND
- +39 ; IB*2.0*618 Allow Event date to File for Community Care RX
- +40 ; IB*2.0*656 Correct a potential Undefined error
- +41 IF IBDESC["RX COPAY"
- IF $GET(IBEVDT)
- Begin DoDot:1
- +42 NEW DIE,DR,DTOUT
- +43 SET DA=IBN
- SET DIE="^IB("
- +44 ;IB*2.0*656
- SET DR=".16///"_$GET(IBEVDA)_";.17///"_IBEVDT
- +45 DO ^DIE
- End DoDot:1
- +46 ; end IB*2.0*618
- +47 ;
- +48 ; GMT Related
- IF $GET(IBGMTR)
- SET $PIECE(^IB(IBN,0),"^",21)=1
- +49 ; DUZ may be null if this code is called by a process started by an HL7 multi-threaded listener
- +50 ; if this condition occurs the approved fix is to use the Postmaster IEN. 2/27/06, IB*2.0*341
- +51 DO NOW^%DTC
- SET $PIECE(^IB(IBN,1),"^")=$SELECT(DUZ:DUZ,1:.5)
- SET $PIECE(^(1),"^",3,5)=$SELECT(DUZ:DUZ,1:.5)_"^"_%_$SELECT($GET(IBCVA):"^"_IBCVA,1:"")
- +52 SET DIK="^IB("
- SET DA=IBN
- DO IX1^DIK
- ADDQ QUIT
- +1 ;
- CTBB ; Charge to be billed
- +1 ; Check Outpat. Fee Service less than 20% Outpat Co Pay
- +2 ; IB*2.0*682
- if $GET(IBREBILL("CHRGAMT"))'=""
- SET IBCHG=IBREBILL("CHRGAMT")
- +3 if $GET(IBAFEE)
- DO FEE^IBECEAU5
- if IBY<1
- QUIT
- +4 ;IB*2.0*653 charge $2.00 per unit ( 1 Unit = 30 day supply), no Tier rates.
- IF $GET(IBDESC)["RX COPAY"
- IF $$CHKHRFS^IBAMTS3(DFN,$GET(IBEFDT))
- SET IBCHG=IBUNIT*2
- +5 WRITE !!,"Charge to be billed --> $",$JUSTIFY(IBCHG,0,2)
- +6 QUIT
- +7 ;
- NODED ; Could not determine the Medicare Deductible amount.
- +1 WRITE !,*7,"The Medicare Deductible Amount for ",$$DAT1^IBOUTL(IBCLDT)," could not be determined."
- +2 WRITE !,"You should determine the cause of this problem before proceeding."
- +3 SET IBY=-1
- +4 QUIT