source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBECEAU3.m@ 1006

Last change on this file since 1006 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.9 KB
Line 
1IBECEAU3 ;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 ;
5ADD ; 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
44ADDQ Q
45 ;
46CTBB ; 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 ;
52NODED ; 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
Note: See TracBrowser for help on using the repository browser.