| 1 | IBECEAU3 ;ALB/CPM-Cancel/Edit/Add... Add New IB Action;11-MAR-93
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**132,150,167,183,341**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ADD ; Add a new Integrated Billing Action entry.
|
|---|
| 6 | ; Input: DFN -- Pointer to patient in file #2
|
|---|
| 7 | ; IBATYP -- Pointer to Action Type in file #350.1
|
|---|
| 8 | ; IBUNIT -- Number of units of charge
|
|---|
| 9 | ; IBCHG -- Total charge
|
|---|
| 10 | ; IBDESC -- Charge description
|
|---|
| 11 | ; IBSITE -- Pointer to the facility in file #4
|
|---|
| 12 | ; IBFAC -- Facility number
|
|---|
| 13 | ; IBFR -- Bill From date
|
|---|
| 14 | ; IBTO -- Bill To date
|
|---|
| 15 | ; IBSL -- Softlink [OPTIONAL]
|
|---|
| 16 | ; IBPARNT -- Pointer to parent entry in #350 [OPTIONAL]
|
|---|
| 17 | ; IBEVDA -- Pointer to parent event in #350 [OPTIONAL], or
|
|---|
| 18 | ; -- "*" to set ibevda=ibn
|
|---|
| 19 | ; IBEVDT -- Event Date [OPTIONAL]
|
|---|
| 20 | ; IBIL -- Bill Number [OPTIONAL]
|
|---|
| 21 | ; IBCRES -- Pointer to canc. reason in #350.3 [OPTIONAL]
|
|---|
| 22 | ; IBXA -- IB Action billing group [OPTIONAL]
|
|---|
| 23 | ; IBJOB -- Option being executed [OPTIONAL]
|
|---|
| 24 | ; IBCVA -- CHAMPVA Admission date [OPTIONAL]
|
|---|
| 25 | ; IBSTOPDA -- Pointer to clinic stop entry in #352.5 [OPTIONAL]
|
|---|
| 26 | ; (used for new outpatient appts created in IB)
|
|---|
| 27 | ; IBGMTR -- GMT Related flag [OPTIONAL]
|
|---|
| 28 | ;
|
|---|
| 29 | ; Output: IBN -- Internal number of new entry in file #350
|
|---|
| 30 | ;
|
|---|
| 31 | N DA,DIK,IBASTR,IBND,Y
|
|---|
| 32 | D ADD^IBAUTL I Y<1 S IBY=Y G ADDQ
|
|---|
| 33 | S:$G(IBEVDA)="*" IBEVDA=IBN
|
|---|
| 34 | 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
|
|---|
| 35 | 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
|
|---|
| 36 | 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:"")
|
|---|
| 37 | I $G(IBSTOPDA) S $P(IBND,"^",19)=IBSTOPDA
|
|---|
| 38 | S $P(^IB(IBN,0),"^",2,20)=IBND
|
|---|
| 39 | I $G(IBGMTR) S $P(^IB(IBN,0),"^",21)=1 ; GMT Related
|
|---|
| 40 | ; DUZ may be null if this code is called by a process started by an HL7 multi-threaded listener
|
|---|
| 41 | ; if this condition occurs the approved fix is to use the Postmaster IEN. 2/27/06, IB*2.0*341
|
|---|
| 42 | 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:"")
|
|---|
| 43 | S DIK="^IB(",DA=IBN D IX1^DIK
|
|---|
| 44 | ADDQ Q
|
|---|
| 45 | ;
|
|---|
| 46 | CTBB ; Charge to be billed
|
|---|
| 47 | ; Check Outpat. Fee Service less than 20% Outpat Co Pay
|
|---|
| 48 | D:$G(IBAFEE) FEE^IBECEAU5 Q:IBY<1
|
|---|
| 49 | W !!,"Charge to be billed --> $",$J(IBCHG,0,2)
|
|---|
| 50 | Q
|
|---|
| 51 | ;
|
|---|
| 52 | NODED ; Could not determine the Medicare Deductible amount.
|
|---|
| 53 | W !,*7,"The Medicare Deductible Amount for ",$$DAT1^IBOUTL(IBCLDT)," could not be determined."
|
|---|
| 54 | W !,"You should determine the cause of this problem before proceeding."
|
|---|
| 55 | S IBY=-1
|
|---|
| 56 | Q
|
|---|
