Summary Table

Categories Total Count
PII 0
URL 0
DNS 0
EKL 0
IP 0
PORT 0
VsID 0
CF 0
AI 0
VPD 0
PL 0
Other 0

File Content

KIDS Distribution saved on May 15, 2019@10:45:26
build 1 version 1a
**KIDS**:IB*2.0*646^

**INSTALL NAME**
IB*2.0*646
"BLD",11310,0)
IB*2.0*646^INTEGRATED BILLING^0^3190515^y
"BLD",11310,4,0)
^9.64PA^^
"BLD",11310,6.3)
4
"BLD",11310,"ABPKG")
n
"BLD",11310,"INIT")
POSTINIT^IB20P646
"BLD",11310,"KRN",0)
^9.67PA^1.5^24
"BLD",11310,"KRN",.4,0)
.4
"BLD",11310,"KRN",.401,0)
.401
"BLD",11310,"KRN",.402,0)
.402
"BLD",11310,"KRN",.403,0)
.403
"BLD",11310,"KRN",.5,0)
.5
"BLD",11310,"KRN",.84,0)
.84
"BLD",11310,"KRN",1.5,0)
1.5
"BLD",11310,"KRN",1.6,0)
1.6
"BLD",11310,"KRN",1.61,0)
1.61
"BLD",11310,"KRN",1.62,0)
1.62
"BLD",11310,"KRN",3.6,0)
3.6
"BLD",11310,"KRN",3.8,0)
3.8
"BLD",11310,"KRN",9.2,0)
9.2
"BLD",11310,"KRN",9.8,0)
9.8
"BLD",11310,"KRN",9.8,"NM",0)
^9.68A^6^6
"BLD",11310,"KRN",9.8,"NM",1,0)
IB20P646^^0^B3806991
"BLD",11310,"KRN",9.8,"NM",2,0)
IBECEA3^^0^B85667020
"BLD",11310,"KRN",9.8,"NM",3,0)
IBECEA33^^0^B24600170
"BLD",11310,"KRN",9.8,"NM",4,0)
IBECEA36^^0^B539878
"BLD",11310,"KRN",9.8,"NM",5,0)
IBECEA2^^0^B4740262
"BLD",11310,"KRN",9.8,"NM",6,0)
IBECEAU2^^0^B34502641
"BLD",11310,"KRN",9.8,"NM","B","IB20P646",1)

"BLD",11310,"KRN",9.8,"NM","B","IBECEA2",5)

"BLD",11310,"KRN",9.8,"NM","B","IBECEA3",2)

"BLD",11310,"KRN",9.8,"NM","B","IBECEA33",3)

"BLD",11310,"KRN",9.8,"NM","B","IBECEA36",4)

"BLD",11310,"KRN",9.8,"NM","B","IBECEAU2",6)

"BLD",11310,"KRN",19,0)
19
"BLD",11310,"KRN",19.1,0)
19.1
"BLD",11310,"KRN",101,0)
101
"BLD",11310,"KRN",409.61,0)
409.61
"BLD",11310,"KRN",771,0)
771
"BLD",11310,"KRN",779.2,0)
779.2
"BLD",11310,"KRN",870,0)
870
"BLD",11310,"KRN",8989.51,0)
8989.51
"BLD",11310,"KRN",8989.52,0)
8989.52
"BLD",11310,"KRN",8994,0)
8994
"BLD",11310,"KRN","B",.4,.4)

"BLD",11310,"KRN","B",.401,.401)

"BLD",11310,"KRN","B",.402,.402)

"BLD",11310,"KRN","B",.403,.403)

"BLD",11310,"KRN","B",.5,.5)

"BLD",11310,"KRN","B",.84,.84)

"BLD",11310,"KRN","B",1.5,1.5)

"BLD",11310,"KRN","B",1.6,1.6)

"BLD",11310,"KRN","B",1.61,1.61)

"BLD",11310,"KRN","B",1.62,1.62)

"BLD",11310,"KRN","B",3.6,3.6)

"BLD",11310,"KRN","B",3.8,3.8)

"BLD",11310,"KRN","B",9.2,9.2)

"BLD",11310,"KRN","B",9.8,9.8)

"BLD",11310,"KRN","B",19,19)

"BLD",11310,"KRN","B",19.1,19.1)

"BLD",11310,"KRN","B",101,101)

"BLD",11310,"KRN","B",409.61,409.61)

"BLD",11310,"KRN","B",771,771)

"BLD",11310,"KRN","B",779.2,779.2)

"BLD",11310,"KRN","B",870,870)

"BLD",11310,"KRN","B",8989.51,8989.51)

"BLD",11310,"KRN","B",8989.52,8989.52)

"BLD",11310,"KRN","B",8994,8994)

"BLD",11310,"QUES",0)
^9.62^^
"BLD",11310,"REQB",0)
^9.611^1^1
"BLD",11310,"REQB",1,0)
IB*2.0*618^1
"BLD",11310,"REQB","B","IB*2.0*618",1)

"INIT")
POSTINIT^IB20P646
"MBREQ")
0
"PKG",230,-1)
1^1
"PKG",230,0)
INTEGRATED BILLING^IB^INTEGRATED BILLING
"PKG",230,22,0)
^9.49I^1^1
"PKG",230,22,1,0)
2.0^2940321^2940525
"PKG",230,22,1,"PAH",1,0)
646^3190515
"QUES","XPF1",0)
Y
"QUES","XPF1","??")
^D REP^XPDH
"QUES","XPF1","A")
Shall I write over your |FLAG| File
"QUES","XPF1","B")
YES
"QUES","XPF1","M")
D XPF1^XPDIQ
"QUES","XPF2",0)
Y
"QUES","XPF2","??")
^D DTA^XPDH
"QUES","XPF2","A")
Want my data |FLAG| yours
"QUES","XPF2","B")
YES
"QUES","XPF2","M")
D XPF2^XPDIQ
"QUES","XPI1",0)
YO
"QUES","XPI1","??")
^D INHIBIT^XPDH
"QUES","XPI1","A")
Want KIDS to INHIBIT LOGONs during the install
"QUES","XPI1","B")
NO
"QUES","XPI1","M")
D XPI1^XPDIQ
"QUES","XPM1",0)
PO^VA(200,:EM
"QUES","XPM1","??")
^D MG^XPDH
"QUES","XPM1","A")
Enter the Coordinator for Mail Group '|FLAG|'
"QUES","XPM1","B")

"QUES","XPM1","M")
D XPM1^XPDIQ
"QUES","XPO1",0)
Y
"QUES","XPO1","??")
^D MENU^XPDH
"QUES","XPO1","A")
Want KIDS to Rebuild Menu Trees Upon Completion of Install
"QUES","XPO1","B")
NO
"QUES","XPO1","M")
D XPO1^XPDIQ
"QUES","XPZ1",0)
Y
"QUES","XPZ1","??")
^D OPT^XPDH
"QUES","XPZ1","A")
Want to DISABLE Scheduled Options, Menu Options, and Protocols
"QUES","XPZ1","B")
NO
"QUES","XPZ1","M")
D XPZ1^XPDIQ
"QUES","XPZ2",0)
Y
"QUES","XPZ2","??")
^D RTN^XPDH
"QUES","XPZ2","A")
Want to MOVE routines to other CPUs
"QUES","XPZ2","B")
NO
"QUES","XPZ2","M")
D XPZ2^XPDIQ
"RTN")
6
"RTN","IB20P646")
0^1^B3806991
"RTN","IB20P646",1,0)
IB20P646 ;SAB/Albany - IB*2.0*646 POST INSTALL;12/11/17 2:10pm
"RTN","IB20P646",2,0)
;;2.0;Integrated Billing;**646**;Mar 20, 1995;Build 4
"RTN","IB20P646",3,0)
;Per VA Directive 6402, this routine should not be modified.
"RTN","IB20P646",4,0)
Q
"RTN","IB20P646",5,0)
;
"RTN","IB20P646",6,0)
POSTINIT ;Post Install for IB*2.0*618
"RTN","IB20P646",7,0)
D BMES^XPDUTL(" >> Starting the Post-Initialization routine for IB*2.0*618 ")
"RTN","IB20P646",8,0)
; Adding AR CATEGORIES and REVENUE SOURCE CODES
"RTN","IB20P646",9,0)
D IBUPD
"RTN","IB20P646",10,0)
D BMES^XPDUTL(" >> End of the Post-Initialization routine for IB*2.0*618")
"RTN","IB20P646",11,0)
Q
"RTN","IB20P646",12,0)
;
"RTN","IB20P646",13,0)
IBUPD ; Inactivate FEE Service Entries
"RTN","IB20P646",14,0)
;
"RTN","IB20P646",15,0)
N LOOP,LIEN,IBDATA
"RTN","IB20P646",16,0)
N X,Y,DIE,DA,DR,DTOUT,DATA
"RTN","IB20P646",17,0)
;
"RTN","IB20P646",18,0)
; Grab all of the entries to update
"RTN","IB20P646",19,0)
D MES^XPDUTL(" -> Activating DG FEE SERVICE (OPT) Action Types (350.1).")
"RTN","IB20P646",20,0)
F LOOP=1:1:3 D
"RTN","IB20P646",21,0)
. ;Extract the new ACTION TYPE to be added.
"RTN","IB20P646",22,0)
. S IBDATA=$T(IBDDAT+LOOP)
"RTN","IB20P646",23,0)
. S IBDATA=$P(IBDATA,";;",2)
"RTN","IB20P646",24,0)
. ;Store in array for adding to the file (#350.1).
"RTN","IB20P646",25,0)
. Q:IBDATA="" ;go to next entry if Category is not to be updated.
"RTN","IB20P646",26,0)
. S LIEN=$O(^IBE(350.1,"B",IBDATA,"")) ; find ACTION TYPE entry
"RTN","IB20P646",27,0)
. Q:LIEN=""
"RTN","IB20P646",28,0)
. ;
"RTN","IB20P646",29,0)
. ; File the update along with inactivate the ACTION TYPE
"RTN","IB20P646",30,0)
. S DR=".12////0"
"RTN","IB20P646",31,0)
. I IBDATA="DG FEE SERVICE (OPT) NEW" S DR=DR_";.08////CC URGENT CARE;20////S IBDESC="_$C(34)_"CC URGENT CARE"_$C(34)
"RTN","IB20P646",32,0)
. S DIE="^IBE(350.1,",DA=LIEN
"RTN","IB20P646",33,0)
. D ^DIE
"RTN","IB20P646",34,0)
. K DR ;Clear update array before next use
"RTN","IB20P646",35,0)
;
"RTN","IB20P646",36,0)
S DR=""
"RTN","IB20P646",37,0)
Q
"RTN","IB20P646",38,0)
;
"RTN","IB20P646",39,0)
IBDDAT ; Fee Service to inactivate
"RTN","IB20P646",40,0)
;;DG FEE SERVICE (OPT) CANCEL
"RTN","IB20P646",41,0)
;;DG FEE SERVICE (OPT) NEW
"RTN","IB20P646",42,0)
;;DG FEE SERVICE (OPT) UPDATE
"RTN","IB20P646",43,0)
Q
"RTN","IBECEA2")
0^5^B4740262
"RTN","IBECEA2",1,0)
IBECEA2 ;ALB/CPM-Cancel/Edit/Add... Edit a Charge ; 15-MAR-93
"RTN","IBECEA2",2,0)
;;2.0;INTEGRATED BILLING;**57,52,150,176,183,240,563,646**;21-MAR-94;Build 4
"RTN","IBECEA2",3,0)
;;Per VA Directive 6402, this routine should not be modified.
"RTN","IBECEA2",4,0)
;
"RTN","IBECEA2",5,0)
ONE ; Edit a single charge.
"RTN","IBECEA2",6,0)
N IBGMTR
"RTN","IBECEA2",7,0)
S IBGMTR=0 ; GMT Related flag
"RTN","IBECEA2",8,0)
;
"RTN","IBECEA2",9,0)
D HDR^IBECEAU("E D I T")
"RTN","IBECEA2",10,0)
;
"RTN","IBECEA2",11,0)
;IB*2.0*646 - Disable ability to edit any Copays. Need to cancel the charge and re-bill.
"RTN","IBECEA2",12,0)
W !,"Sorry! Editing a copayment is not allowed within Integrated Billing.",!,"Please cancel this charge and add a new charge."
"RTN","IBECEA2",13,0)
;
"RTN","IBECEA2",14,0)
; - don't allow edit of CHAMPVA charges
"RTN","IBECEA2",15,0)
;I $P($G(^IB(IBN,1)),"^",5) W !,"Sorry! You cannot edit the CHAMPVA inpatient subsistence charge.",!,"Please cancel this charge and add a new charge." G ONEQ
"RTN","IBECEA2",16,0)
;
"RTN","IBECEA2",17,0)
; - don't allow edit of TRICARE charges
"RTN","IBECEA2",18,0)
;I $P($G(^IBE(350.1,+$P($G(^IB(IBN,0)),"^",3),0)),"^",11)=7 W !,"Sorry! You cannot edit TRICARE copayment charges.",!,"Please cancel this charge and add a new charge." G ONEQ
"RTN","IBECEA2",19,0)
;
"RTN","IBECEA2",20,0)
; - don't allow edit of LTC charges
"RTN","IBECEA2",21,0)
;S IBXA=$P($G(^IBE(350.1,+$P($G(^IB(IBN,0)),"^",3),0)),"^",11)
"RTN","IBECEA2",22,0)
;I IBXA>7,IBXA<10 W !,"Sorry! You cannot edit LTC copayment charges.",!,"Please cancel this charge and add a new charge." G ONEQ
"RTN","IBECEA2",23,0)
;
"RTN","IBECEA2",24,0)
; - perform up-front edits
"RTN","IBECEA2",25,0)
;I 'IBND S IBY="-1^IB021" G ONEQ
"RTN","IBECEA2",26,0)
;S IBPARNT=+$P(IBND,"^",9) I '$D(^IB(IBPARNT,0)) S IBY="-1^IB027" G ONEQ
"RTN","IBECEA2",27,0)
;I $$LAST^IBECEAU(IBPARNT)'=IBN W !,"You can only edit the last transaction for an original charge." G ONEQ
"RTN","IBECEA2",28,0)
;S IBATYP=$G(^IBE(350.1,+$P(IBND,"^",3),0)) I IBATYP="" S IBY="-1^IB022" G ONEQ
"RTN","IBECEA2",29,0)
;S IBSEQNO=$P(IBATYP,"^",5) I 'IBSEQNO S IBY="-1^IB023" G ONEQ
"RTN","IBECEA2",30,0)
;I $P(IBATYP,"^",5)=2 W !,"You cannot edit cancellation transactions... please add a new charge." G ONEQ
"RTN","IBECEA2",31,0)
;I $P(IBND,"^",5)=10 W !,"You cannot edit charges which have been directly cancelled.",!,"Please add a new charge." G ONEQ
"RTN","IBECEA2",32,0)
;
"RTN","IBECEA2",33,0)
; - see if charge has been billed or not
"RTN","IBECEA2",34,0)
;S IBH="^1^2^8^9^99^"[("^"_+$P(IBND,"^",5)_"^"),IBXA=$P(IBATYP,"^",11)
"RTN","IBECEA2",35,0)
;S IBIL=$P(IBND,"^",11),IBUNITP=+$P(IBND,"^",6),IBCHGP=+$P(IBND,"^",7)
"RTN","IBECEA2",36,0)
;S IBATYP=+$P($G(^IBE(350.1,+$P(IBND,"^",3),0)),"^",9)
"RTN","IBECEA2",37,0)
;I 'IBH D G:IBY<0 ONEQ
"RTN","IBECEA2",38,0)
;.I 'IBUNITP W !,"This charge has been billed, but there are no units!" S IBY=-1 Q
"RTN","IBECEA2",39,0)
;.I 'IBCHGP W !,"There is no charge amount associated with this action!" S IBY=-1 Q
"RTN","IBECEA2",40,0)
;.I IBIL="" W !,"This charge has been billed, but there is no bill number!" S IBY=-1 Q
"RTN","IBECEA2",41,0)
;I IBH,$P(IBND,"^",5)'=8 W !,"*** Please Note: This charge has not yet been passed to Accounts Receivable ***"
"RTN","IBECEA2",42,0)
;I $P(IBND,"^",5)=8 W !?17,"*** Please Note: This charge is on hold. ***",!?9,"Editing it will cause it to be passed to Accounts Receivable."
"RTN","IBECEA2",43,0)
;
"RTN","IBECEA2",44,0)
; - ask user for the cancellation reason
"RTN","IBECEA2",45,0)
;I 'IBH,IBXA'=4 D REAS^IBECEAU2("E") G:IBCRES<0 ONEQ
"RTN","IBECEA2",46,0)
;
"RTN","IBECEA2",47,0)
; - ask user for data to be edited
"RTN","IBECEA2",48,0)
;D ^IBECEA21 G:IBY<0 ONEQ
"RTN","IBECEA2",49,0)
;
"RTN","IBECEA2",50,0)
; - okay to proceed?
"RTN","IBECEA2",51,0)
;D PROC^IBECEAU4("edit") G:IBY<0 ONEQ S IBUPD=IBND
"RTN","IBECEA2",52,0)
;
"RTN","IBECEA2",53,0)
; - cancel 354.71 transaction (copay cap)
"RTN","IBECEA2",54,0)
;S:$P(IBND,"^",19) IBAMC=$$CANCEL^IBARXMN(DFN,$P(IBND,"^",19),.IBY) G:IBY<0 ONEQ
"RTN","IBECEA2",55,0)
;
"RTN","IBECEA2",56,0)
; - build the cancellation transaction
"RTN","IBECEA2",57,0)
;D CANC^IBECEAU4(IBN,IBCRES,0) G:IBY<0 ONEQ
"RTN","IBECEA2",58,0)
;
"RTN","IBECEA2",59,0)
; - build new 354.71 transaction (copay cap)
"RTN","IBECEA2",60,0)
;I IBXA=5 W !!,"Building the new cap transaction... " S IBAM=$$ADD^IBARXMN(DFN,"^^"_$G(IBEFDT,DT)_"^^P^^"_IBUNIT_"^"_IBCHG_"^"_IBDESC_"^^"_IBCHG_"^0^"_IBSITE_"^^^^^^^"_$G(IBTIER)) I IBAM<0 S IBY="-1^IB316" G ONEQ
"RTN","IBECEA2",61,0)
;
"RTN","IBECEA2",62,0)
; - build the updated transaction
"RTN","IBECEA2",63,0)
;D UPD^IBECEA22 G:IBY<0 ONEQ
"RTN","IBECEA2",64,0)
;
"RTN","IBECEA2",65,0)
; - handle updating of clock
"RTN","IBECEA2",66,0)
;I "^1^2^3^"[("^"_IBXA_"^") D CLOCK^IBECEAU(IBDOLA-IBCLDOL,IBCLDAY,IBDAYA-IBCLDAY)
"RTN","IBECEA2",67,0)
;
"RTN","IBECEA2",68,0)
ONEQ D ERR^IBECEAU4:IBY<0,PAUSE^IBECEAU
"RTN","IBECEA2",69,0)
K IBBS,IBCRES,IBDESC,IBIL,IBND,IBARTYP,IBSEQNO,IBTOTL,IBUNIT,IBATYP,IBIDX,IBN,IBY,IBPARNT,IBH,IBXA,IBNOS,IBRTED,IBADJMED,IBAM,IBAMC,IBEFDT,IBTIER
"RTN","IBECEA2",70,0)
K IBAFY,IBCAN,IBCHG,IBCHGP,IBCLDA,IBCLDAY,IBCLDOL,IBCLDOLO,IBCLDT,IBCLST,IBDAYA,IBDAYP,IBDOLA,IBDOLP,IBDT,IBFR,IBFRP,IBI,IBJ,IBLIM,IBMED,IBTO,IBTOP,IBTRAN,IBUNIT,IBUNITP,IBUPD
"RTN","IBECEA2",71,0)
Q
"RTN","IBECEA3")
0^2^B85667020
"RTN","IBECEA3",1,0)
IBECEA3 ;ALB/CPM - Cancel/Edit/Add... Add a Charge ;30-MAR-93
"RTN","IBECEA3",2,0)
;;2.0;INTEGRATED BILLING;**7,57,52,132,150,153,166,156,167,176,198,188,183,202,240,312,402,454,563,614,618,646**;21-MAR-94;Build 4
"RTN","IBECEA3",3,0)
;;Per VA Directive 6402, this routine should not be modified.
"RTN","IBECEA3",4,0)
;
"RTN","IBECEA3",5,0)
ADD ; Add a Charge protocol
"RTN","IBECEA3",6,0)
N IBGMT,IBGMTR,IBUSNM,IBUC ;IB*2.0*618 Add IBUSNM IB*2.0*646 Add IBUC
"RTN","IBECEA3",7,0)
S (IBGMT,IBGMTR,IBUC)=0
"RTN","IBECEA3",8,0)
S IBCOMMIT=0,IBEXSTAT=$$RXST^IBARXEU(DFN,DT),IBCATC=$$BILST^DGMTUB(DFN),IBCVAEL=$$CVA^IBAUTL5(DFN),IBLTCST=$$LTCST^IBAECU(DFN,DT,1)
"RTN","IBECEA3",9,0)
;I 'IBCVAEL,'IBCATC,'$G(IBRX),+IBEXSTAT<1 W !!,"This patient has never been Means Test billable." S VALMBCK="" D PAUSE^VALM1 G ADDQ1
"RTN","IBECEA3",10,0)
;
"RTN","IBECEA3",11,0)
; - clear screen and begin
"RTN","IBECEA3",12,0)
D CLOCK^IBAUTL3 I 'IBCLDA S (IBMED,IBCLDAY,IBCLDOL,IBCLDT)=0
"RTN","IBECEA3",13,0)
D HDR^IBECEAU("A D D")
"RTN","IBECEA3",14,0)
I IBY<0 D NODED^IBECEAU3 G ADDQ
"RTN","IBECEA3",15,0)
;
"RTN","IBECEA3",16,0)
; - ask for the charge type
"RTN","IBECEA3",17,0)
D CHTYP^IBECEA33 G:IBY<0 ADDQ
"RTN","IBECEA3",18,0)
;
"RTN","IBECEA3",19,0)
;***IB*2.0*618 change to add more Action Types to this list...
"RTN","IBECEA3",20,0)
; Allow user to add an extra "co-payment" charge if the Action Type
"RTN","IBECEA3",21,0)
; selected is an Outpatient FEE BASIS, CHOICE, CC or CCN charge type
"RTN","IBECEA3",22,0)
N IBAFEE
"RTN","IBECEA3",23,0)
S IBUSNM=$P($G(^IBE(350.1,+$G(IBATYP),0)),"^",8)
"RTN","IBECEA3",24,0)
I IBUSNM'="" D
"RTN","IBECEA3",25,0)
. I IBUSNM="FEE SERVICE/OUTPATIENT" S IBAFEE=IBATYP Q
"RTN","IBECEA3",26,0)
. I (IBUSNM["CC")!(IBUSNM["CHOICE") D
"RTN","IBECEA3",27,0)
. . I (IBUSNM["OPT")!(IBUSNM["OUTPATIENT")!(IBUSNM["URGENT") S IBAFEE=IBATYP ;IB*2.0*646 added URGENT
"RTN","IBECEA3",28,0)
;*** END IB*2.0*618 ***
"RTN","IBECEA3",29,0)
;
"RTN","IBECEA3",30,0)
; - process CHAMPVA charges
"RTN","IBECEA3",31,0)
I IBXA=6 D CHMPVA^IBECEA32 G ADDQ
"RTN","IBECEA3",32,0)
;
"RTN","IBECEA3",33,0)
; - process TRICARE charges
"RTN","IBECEA3",34,0)
I IBXA=7 D CUS^IBECEA35 G ADDQ
"RTN","IBECEA3",35,0)
;
"RTN","IBECEA3",36,0)
; - display MT billing clock data
"RTN","IBECEA3",37,0)
I IBXA=2,$P($G(^IBE(350.1,+IBATYP,0)),"^",8)'["NHCU",IBCLDAY>90 S IBMED=IBMED/2
"RTN","IBECEA3",38,0)
I IBXA=1,IBCLDAY>90 D MED^IBECEA34 G:IBY<0 ADDQ
"RTN","IBECEA3",39,0)
I "^1^2^3^"[("^"_IBXA_"^"),IBCLDA W !!," ** Active Billing Clock ** # Inpt Days: ",IBCLDAY," ",$$INPT^IBECEAU(IBCLDAY)," 90 days: $",+IBCLDOL,!
"RTN","IBECEA3",40,0)
;
"RTN","IBECEA3",41,0)
; - if LTC OPT (non-institutional) and CD display message of warning
"RTN","IBECEA3",42,0)
I IBXA=8,$$CDEXMPT^IBAECU(DFN,DT) W !!," ** Patient is currently Catastrophically Disabled",!
"RTN","IBECEA3",43,0)
;
"RTN","IBECEA3",44,0)
; - display LTC billing clock data
"RTN","IBECEA3",45,0)
I IBXA>7,IBXA<10 D G:IBCLDA<1 ADDQ
"RTN","IBECEA3",46,0)
. N IBCLZ
"RTN","IBECEA3",47,0)
. S IBCLDA=$O(^IBA(351.81,"AE",DFN,9999999),-1)
"RTN","IBECEA3",48,0)
. S:IBCLDA IBCLDA=$O(^IBA(351.81,"AE",DFN,IBCLDA,0))
"RTN","IBECEA3",49,0)
. I 'IBCLDA W !!," ** Patient has no LTC billing clock **" Q
"RTN","IBECEA3",50,0)
. S IBCLZ=^IBA(351.81,IBCLDA,0)
"RTN","IBECEA3",51,0)
. W !!," **Last LTC Billing Clock Start Date: ",$$FMTE^XLFDT($P(IBCLZ,"^",3))," Free Days Remaining: ",+$P(IBCLZ,"^",6)
"RTN","IBECEA3",52,0)
. I $P(IBCLZ,"^",6) W !,"The patient must use his free days first." S IBCLDA=0
"RTN","IBECEA3",53,0)
;
"RTN","IBECEA3",54,0)
; - ask date, units and maybe tier for rx copay charge
"RTN","IBECEA3",55,0)
I IBXA=5 D G ADDQ:IBY<0,PROC
"RTN","IBECEA3",56,0)
. N IBA,IBB,IBC,IBX
"RTN","IBECEA3",57,0)
. S IBLIM=DT D FR^IBECEAU2(0) Q:IBY<0
"RTN","IBECEA3",58,0)
. S (IBTO,IBEFDT)=IBFR
"RTN","IBECEA3",59,0)
. ;
"RTN","IBECEA3",60,0)
. ;PRCA*4.5*338 - if Community Care RX copay, set event date
"RTN","IBECEA3",61,0)
. I (IBXA=5),(IBUSNM["RX"),((IBUSNM["CC")!(IBUSNM["CHOICE")) S IBEVDA="*",IBEVDT=IBEFDT
"RTN","IBECEA3",62,0)
. ;
"RTN","IBECEA3",63,0)
. ; ask tier if needed
"RTN","IBECEA3",64,0)
. S IBTIER=$$TIER^IBECEAU2(IBATYP,IBEFDT) Q:IBY<0
"RTN","IBECEA3",65,0)
. ;
"RTN","IBECEA3",66,0)
. ; ask units
"RTN","IBECEA3",67,0)
. D UNIT^IBECEAU2(0) Q:IBY<0
"RTN","IBECEA3",68,0)
. ;
"RTN","IBECEA3",69,0)
. ; has patient been previously tracked for cap info
"RTN","IBECEA3",70,0)
. D TRACK^IBARXMN(DFN)
"RTN","IBECEA3",71,0)
. ;
"RTN","IBECEA3",72,0)
. D CTBB^IBECEAU3
"RTN","IBECEA3",73,0)
. ;
"RTN","IBECEA3",74,0)
. ; check if above cap
"RTN","IBECEA3",75,0)
. I IBY'<0 D
"RTN","IBECEA3",76,0)
.. N IBB,IBN,DIR,DIRUT,DUOUT,DTOUT,X,Y
"RTN","IBECEA3",77,0)
.. D NEW^IBARXMC(1,IBCHG,IBFR,.IBB,.IBN) Q:'IBN
"RTN","IBECEA3",78,0)
.. ;
"RTN","IBECEA3",79,0)
.. ; display message ask to proceed
"RTN","IBECEA3",80,0)
.. W !!,"This charge will put the patient > $",$J(IBN,0,2)," above their cap amount."
"RTN","IBECEA3",81,0)
.. S DIR(0)="Y",DIR("A")="Okay to proceed" D ^DIR S:'Y IBY=-1
"RTN","IBECEA3",82,0)
.. ;
"RTN","IBECEA3",83,0)
S IBLIM=$S(IBXA=4!(IBXA=3):DT,1:$$FMADD^XLFDT(DT,-1))
"RTN","IBECEA3",84,0)
;
"RTN","IBECEA3",85,0)
FR ; - ask 'bill from' date
"RTN","IBECEA3",86,0)
D FR^IBECEAU2(0) G:IBY<0 ADDQ
"RTN","IBECEA3",87,0)
;
"RTN","IBECEA3",88,0)
;IB*2.0*646
"RTN","IBECEA3",89,0)
; If Urgent Care copay, skip clock checks, go to prompt for copay amount.
"RTN","IBECEA3",90,0)
G:$G(IBUC) UCPAY
"RTN","IBECEA3",91,0)
; end IB*2.0*646
"RTN","IBECEA3",92,0)
S IBGMT=$$ISGMTPT^IBAGMT(DFN,IBFR),IBGMTR=0 ;GMT Copayment Status
"RTN","IBECEA3",93,0)
I IBGMT>0,IBXA>0,IBXA<4 W !,"The patient has GMT Copayment Status."
"RTN","IBECEA3",94,0)
; - check the MT billing clock
"RTN","IBECEA3",95,0)
I IBXA'=8,IBXA'=9 D CLMSG^IBECEA33 G:IBY<0 ADDQ
"RTN","IBECEA3",96,0)
;Adjust Deductible for GMT patient
"RTN","IBECEA3",97,0)
I IBGMT>0,IBXA>0,IBXA<4,$G(IBMED) S IBMED=$$REDUCE^IBAGMT(IBMED) W !,"Medicare Deductible reduced due to GMT Copayment Status ($",$J(IBMED,"",2),")."
"RTN","IBECEA3",98,0)
;
"RTN","IBECEA3",99,0)
; - check LTC non-institutional (opt) for CD exemption
"RTN","IBECEA3",100,0)
I IBXA=8,$$CDEXMPT^IBAECU(DFN,IBFR) W !,"Patient is LTC non-institutional exempt, Catastrophically Disabled" G ADDQ
"RTN","IBECEA3",101,0)
;
"RTN","IBECEA3",102,0)
; - check the LTC billing clock
"RTN","IBECEA3",103,0)
I IBXA>7,IBXA<10 D I IBY<0 W !!,"The patient has no LTC clock active for the date.",! G ADDQ
"RTN","IBECEA3",104,0)
. N IBCLZ S IBCLZ=^IBA(351.81,IBCLDA,0)
"RTN","IBECEA3",105,0)
. ;
"RTN","IBECEA3",106,0)
. ; is this the clock and within the date range
"RTN","IBECEA3",107,0)
. I IBFR'<$P(IBCLZ,"^",3),$$YR^IBAECU($P(IBCLZ,"^",3),IBFR) S IBY=-1 Q
"RTN","IBECEA3",108,0)
. ;
"RTN","IBECEA3",109,0)
. ; look for another clock that might fit the date
"RTN","IBECEA3",110,0)
. I IBFR<$P(IBCLZ,"^",3) S IBCLDA=$O(^IBA(351.81,"AE",DFN,IBFR+1),-1) I 'IBCLDA!($$YR^IBAECU($P($G(^IBA(351.81,+IBCLDA,0)),"^",3),IBFR)) S IBY=-1
"RTN","IBECEA3",111,0)
;
"RTN","IBECEA3",112,0)
; - calculate the MT inpt copay charge
"RTN","IBECEA3",113,0)
I IBXA=2 S IBDT=IBFR D COPAY^IBAUTL2 G ADDQ:IBY<0 S:IBGMT>0 IBGMTR=1,IBCHG=$$REDUCE^IBAGMT(IBCHG) I IBCHG+IBCLDOL<IBMED W *7," ($",IBCHG,"/day)" W:IBGMTR " GMT Rate"
"RTN","IBECEA3",114,0)
;
"RTN","IBECEA3",115,0)
; - find the correct clock from the 'bill from' date (ignore LTC)
"RTN","IBECEA3",116,0)
I IBXA'=8,IBXA'=9,('IBCLDA!(IBCLDA&(IBFR<IBCLDT))) D NOCL^IBECEA33 G:IBY<0 ADDQ
"RTN","IBECEA3",117,0)
;
"RTN","IBECEA3",118,0)
UCPAY ;IB*2.0*646 Added to allow for skip of clock checks - required for Urgent Care Copays
"RTN","IBECEA3",119,0)
; - perform outpatient edits
"RTN","IBECEA3",120,0)
N IBSTOPDA
"RTN","IBECEA3",121,0)
;IB*2.0*646 If urgent care, process using UC criteria and go to process
"RTN","IBECEA3",122,0)
I IBXA=4,IBUC D UCCHRG^IBECEA36 G ADDQ:IBY<0,PROC
"RTN","IBECEA3",123,0)
;end IB*2.0*646
"RTN","IBECEA3",124,0)
;
"RTN","IBECEA3",125,0)
I IBXA=4,$$CHKHRFS^IBAMTS3(DFN,IBFR,IBFR) W !!,"This patient is 'Exempt' from Outpatient Visit charges on that date of service.",! G ADDQ ;IB*2.0*614 (no copayment if HRfS flag)
"RTN","IBECEA3",126,0)
I IBXA=4 D G ADDQ:IBY<0,PROC
"RTN","IBECEA3",127,0)
. ; for visits prior to 12/6/01 or FEE
"RTN","IBECEA3",128,0)
. I IBFR<3011206!($G(IBAFEE)) D OPT^IBECEA33 Q
"RTN","IBECEA3",129,0)
. ; for visits on or after 12/5/01
"RTN","IBECEA3",130,0)
. D OPT^IBEMTSCU
"RTN","IBECEA3",131,0)
;
"RTN","IBECEA3",132,0)
; - if LTC outpatient calculate the charge
"RTN","IBECEA3",133,0)
I IBXA=8 D G:IBY<0 ADDQ S (IBDT,IBTO,IBEVDT)=IBFR,IBDESC=$P(^IBE(350.1,IBATYP,0),"^",8),IBUNIT=1,IBEVDA="*" D COST^IBAUTL2,CALC^IBAECO,CTBB^IBECEAU3 G @$S(IBCHG:"PROC",1:"ADDQ")
"RTN","IBECEA3",134,0)
. ;
"RTN","IBECEA3",135,0)
. ; is this day already a free day
"RTN","IBECEA3",136,0)
. I $D(^IBA(351.81,IBCLDA,1,"AC",IBFR)) W !!,"This day is already marked as a Free Day." S IBY=-1
"RTN","IBECEA3",137,0)
. ;
"RTN","IBECEA3",138,0)
. ; have we already billed for this day
"RTN","IBECEA3",139,0)
. I $$BFO^IBECEAU(DFN,IBFR) W !!,"This patient has already been billed for this date." S IBY=-1
"RTN","IBECEA3",140,0)
;
"RTN","IBECEA3",141,0)
; - find per diem charge and description
"RTN","IBECEA3",142,0)
I IBXA=3 D I 'IBCHG W !!,"Unable to determine the per diem rate. Please check your rate table." G ADDQ
"RTN","IBECEA3",143,0)
.N IBDT S IBDT=IBFR,IBGMTR=0 D COST^IBAUTL2
"RTN","IBECEA3",144,0)
.I IBGMT>0 S IBGMTR=1,IBCHG=$$REDUCE^IBAGMT(IBCHG)
"RTN","IBECEA3",145,0)
.S IBDESC="" X:$D(^IBE(350.1,IBATYP,20)) ^(20)
"RTN","IBECEA3",146,0)
;
"RTN","IBECEA3",147,0)
; - calculate charge for the inpatient copay
"RTN","IBECEA3",148,0)
I IBXA=2,IBCHG+IBCLDOL'<IBMED S IBCHG=IBMED-IBCLDOL,IBUNIT=1,IBTO=IBFR D CTBB^IBECEAU3 G EV
"RTN","IBECEA3",149,0)
;
"RTN","IBECEA3",150,0)
TO ; - ask 'bill to' date
"RTN","IBECEA3",151,0)
D TO^IBECEAU2(0) G:IBY<0 ADDQ
"RTN","IBECEA3",152,0)
;
"RTN","IBECEA3",153,0)
I IBXA>0,IBXA<4,IBGMT'=$$ISGMTPT^IBAGMT(DFN,IBTO) W !!,"The patient's GMT Copayment status changed within the specified period!",! G ADDQ
"RTN","IBECEA3",154,0)
;
"RTN","IBECEA3",155,0)
; - calculate unit charge for LTC inpatient in IBCHG
"RTN","IBECEA3",156,0)
I IBXA=9 S IBDT=IBFR,IBEVDA=$$EVF^IBECEA31(DFN,IBFR,IBTO,IBNH),IBEVDT=$E(IBFR,1,5)_"01" D:IBEVDA<1 G ADDQ:IBY<0 D COST^IBAUTL2 I $E(IBFR,1,5)'=$E(IBTO,1,5) W !!," LTC Copayment charges cannot go from one month to another." G ADDQ
"RTN","IBECEA3",157,0)
. D NOEV^IBECEA31 I '$G(IBDG)!(IBY<0) S IBY=-1 Q
"RTN","IBECEA3",158,0)
. ; - build the event record
"RTN","IBECEA3",159,0)
. N IBNHLTC S IBNHLTC=1 D ADEV^IBECEA31
"RTN","IBECEA3",160,0)
;
"RTN","IBECEA3",161,0)
;
"RTN","IBECEA3",162,0)
; - calculate units and total charge
"RTN","IBECEA3",163,0)
S IBUNIT=$$FMDIFF^XLFDT(IBTO,IBFR) S:IBXA'=3!(IBFR=IBTO) IBUNIT=IBUNIT+1
"RTN","IBECEA3",164,0)
I IBXA=1 D:IBGMT>0 D FEPR^IBECEA32 G ADDQ:IBY<0,EV
"RTN","IBECEA3",165,0)
. S IBGMTR=1
"RTN","IBECEA3",166,0)
. W !,"The patient has GMT Copayment Status! GMT rate must be applied.",!
"RTN","IBECEA3",167,0)
S IBCHG=IBCHG*IBUNIT S:IBXA=2 IBCHG=$S(IBCLDOL+IBCHG>IBMED:IBMED-IBCLDOL,1:IBCHG)
"RTN","IBECEA3",168,0)
;
"RTN","IBECEA3",169,0)
; adjust the LTC charge based on the calculated copay cap
"RTN","IBECEA3",170,0)
I IBXA=9 D CALC^IBAECI G:IBY<1!('IBCHG) ADDQ S IBDESC="LTC INPATIENT COPAY"
"RTN","IBECEA3",171,0)
;
"RTN","IBECEA3",172,0)
D CTBB^IBECEAU3 W:IBXA=3!(IBXA=9) " (for ",IBUNIT," day",$E("s",IBUNIT>1),")" W:IBGMTR " GMT Rate"
"RTN","IBECEA3",173,0)
;
"RTN","IBECEA3",174,0)
EV ; - find event record, or select admission for linkage
"RTN","IBECEA3",175,0)
I IBXA'=9 S IBEVDA=$$EVF^IBECEA31(DFN,IBFR,IBTO,IBNH)
"RTN","IBECEA3",176,0)
I IBEVDA'>0 D NOEV^IBECEA31 G ADDQ:IBY<0,PROC
"RTN","IBECEA3",177,0)
S IBSL=$P($G(^IB(+IBEVDA,0)),"^",4)
"RTN","IBECEA3",178,0)
W !!,"Linked charge to ",$$TYP(),"admission on ",$$DAT1^IBOUTL($P(IBEVDA,"^",2))," ("
"RTN","IBECEA3",179,0)
W $S($P(IBEVDA,"^",3)=9999999:"Still admitted)",1:"Discharged on "_$$DAT1^IBOUTL($P(IBEVDA,"^",3))_$S($P(IBEVDA,"^",3)>DT:" [pseudo])",1:")"))," ..."
"RTN","IBECEA3",180,0)
S IBEVDA=+IBEVDA
"RTN","IBECEA3",181,0)
I '$G(IBSIBC) D SPEC^IBECEA32(0,$O(^IBE(351.2,"AD",IBEVDA,0)))
"RTN","IBECEA3",182,0)
;
"RTN","IBECEA3",183,0)
;
"RTN","IBECEA3",184,0)
PROC ; - okay to proceed?
"RTN","IBECEA3",185,0)
D PROC^IBECEAU4("add") G:IBY<0 ADDQ
"RTN","IBECEA3",186,0)
;
"RTN","IBECEA3",187,0)
; - build the event record first if necessary
"RTN","IBECEA3",188,0)
I $G(IBDG),IBXA'=9 D @("ADEV^IBECEA3"_$S($G(IBFEEV):4,1:1)) G:IBY<0 ADDQ
"RTN","IBECEA3",189,0)
;
"RTN","IBECEA3",190,0)
; - disposition the special inpatient billing case, if necessary
"RTN","IBECEA3",191,0)
I $G(IBSIBC) D CEA^IBAMTI1(IBSIBC,IBEVDA)
"RTN","IBECEA3",192,0)
;
"RTN","IBECEA3",193,0)
; - generate entry in file #354.71 (for VA RX only per IB*2.0*618) and #350
"RTN","IBECEA3",194,0)
I IBXA=5,(IBUSNM'["CC"),(IBUSNM'["CHOICE") W !!,"Building the new transaction... " S IBAM=$$ADD^IBARXMN(DFN,"^^"_IBEFDT_"^^P^^"_IBUNIT_"^"_IBCHG_"^"_IBDESC_"^^"_IBCHG_"^0^"_IBSITE_"^^^^^^^"_$G(IBTIER)) G:IBAM<0 ADDQ
"RTN","IBECEA3",195,0)
D ADD^IBECEAU3 G:IBY<0 ADDQ W "done."
"RTN","IBECEA3",196,0)
;
"RTN","IBECEA3",197,0)
; - pass the charge off to AR on-line
"RTN","IBECEA3",198,0)
W !,"Passing the charge directly to Accounts Receivable... "
"RTN","IBECEA3",199,0)
D PASSCH^IBECEA22 W:IBY>0 "done." G:IBY<0 ADDQ
"RTN","IBECEA3",200,0)
;
"RTN","IBECEA3",201,0)
; - review the special inpatient billing case
"RTN","IBECEA3",202,0)
I $G(IBSIBC1) D CHK^IBAMTI1(IBSIBC1,IBEVDA)
"RTN","IBECEA3",203,0)
;
"RTN","IBECEA3",204,0)
; - handle updating of clock
"RTN","IBECEA3",205,0)
I IBXA'=8,IBXA'=9,'IBUC D CLUPD^IBECEA32 ;IB*2.0*646
"RTN","IBECEA3",206,0)
;
"RTN","IBECEA3",207,0)
ADDQ ; - display error, rebuild list, and quit
"RTN","IBECEA3",208,0)
D ERR^IBECEAU4:IBY<0,PAUSE^IBECEAU S VALMBCK="R"
"RTN","IBECEA3",209,0)
I IBCOMMIT S IBBG=VALMBG W !,"Rebuilding list of charges..." D ARRAY^IBECEA0 S VALMBG=IBBG
"RTN","IBECEA3",210,0)
K IBMED,IBCLDA,IBCLDT,IBCLDOL,IBCLDAY,IBATYP,IBDG,IBSEQNO,IBXA,IBNH,IBBS,IBLIM,IBFR,IBTO,IBRTED,IBSIBC,IBSIBC1,IBBG,IBFEEV,IBAM
"RTN","IBECEA3",211,0)
K IBX,IBCHG,IBUNIT,IBDESC,IBDT,IBEVDT,IBEVDA,IBSL,IBNOS,IBN,IBTOTL,IBARTYP,IBIL,IBTRAN,IBAFY,IBCVA,IBCLSF,IBDD,IBND,VADM,VA,VAERR,IBADJMED
"RTN","IBECEA3",212,0)
ADDQ1 K IBEXSTAT,IBCOMMIT,IBCATC,IBCVAEL,IBLTCST,IBTIER,IBEFDT
"RTN","IBECEA3",213,0)
Q
"RTN","IBECEA3",214,0)
;
"RTN","IBECEA3",215,0)
;
"RTN","IBECEA3",216,0)
TYP() ; Return descriptive admission type.
"RTN","IBECEA3",217,0)
N X S X=""
"RTN","IBECEA3",218,0)
I IBNH'=2 G TYPQ
"RTN","IBECEA3",219,0)
I $G(IBADJMED) S X=$S(IBADJMED=1:"C",1:"H")
"RTN","IBECEA3",220,0)
E S X=$S($P($G(^IBE(350.1,+IBATYP,0)),"^")["NHCU":"C",1:"H")
"RTN","IBECEA3",221,0)
S X=$S(X="C":"CNH ",1:"Contract Hospital ")
"RTN","IBECEA3",222,0)
TYPQ Q X
"RTN","IBECEA33")
0^3^B24600170
"RTN","IBECEA33",1,0)
IBECEA33 ;ALB/CPM-Cancel/Edit/Add... More Add Utilities ; 23-APR-93
"RTN","IBECEA33",2,0)
;;2.0;INTEGRATED BILLING;**57,52,132,153,167,176,188,618,646**;21-MAR-94;Build 4
"RTN","IBECEA33",3,0)
;;Per VHA Directive 10-93-142, this routine should not be modified.
"RTN","IBECEA33",4,0)
;
"RTN","IBECEA33",5,0)
NOCL ; Find the correct clock from the 'bill from' date.
"RTN","IBECEA33",6,0)
N IBCLST,IBALR S IBALR=0
"RTN","IBECEA33",7,0)
I IBCLDA S IBALR=1 W !!,"The Bill From date is prior to the start of the active clock..."
"RTN","IBECEA33",8,0)
D CLSTR^IBECEAU1(DFN,IBFR)
"RTN","IBECEA33",9,0)
I 'IBCLDA D G NOCLQ
"RTN","IBECEA33",10,0)
.I IBALR W !!,"This patient has no clock which would cover this date. You should use the",!,"Clock Maintenance option to adjust this patient's clocks before proceeding." S IBY=-1 Q
"RTN","IBECEA33",11,0)
.W !!,"Please note that I cannot find an active or closed clock for this patient",!,"on this date.",!
"RTN","IBECEA33",12,0)
D CLDATA^IBAUTL3,DED^IBAUTL3 I IBY<0 D NODED^IBECEAU3 G NOCLQ
"RTN","IBECEA33",13,0)
I IBXA=2,$P($G(^IBE(350.1,IBATYP,0)),"^",8)'["NHCU",IBCLDAY>90 S IBMED=IBMED/2
"RTN","IBECEA33",14,0)
I IBXA=1,IBCLDAY>90,$G(IBADJMED)'=1 S:$G(IBADJMED)=2 IBMED=IBMED/2 I '$G(IBADJMED) D MED^IBECEA34 G:IBY<0 NOCLQ
"RTN","IBECEA33",15,0)
S IBLIM=$S($P(IBCLST,"^",10):$P(IBCLST,"^",10),1:$$FMADD^XLFDT(IBCLDT,364))
"RTN","IBECEA33",16,0)
W !!?5,"This charge will be billed under the following closed clock:"
"RTN","IBECEA33",17,0)
W !!?6,"Begin Date: ",$$DAT1^IBOUTL(IBCLDT)," # Inpt Days: ",IBCLDAY
"RTN","IBECEA33",18,0)
W !?5,"Closed Date: ",$$DAT1^IBOUTL($P(IBCLST,"^",10))," ",$$INPT^IBECEAU(IBCLDAY)," 90 Days: $",+IBCLDOL
"RTN","IBECEA33",19,0)
I IBXA=2,IBCLDOL'<IBMED S IBY=-1 W !!?5,"This patient has been billed the full copayment under this billing clock!",!?5,"You cannot add another copay charge starting on this date."
"RTN","IBECEA33",20,0)
NOCLQ Q
"RTN","IBECEA33",21,0)
;
"RTN","IBECEA33",22,0)
OPT ; Check for a C&P exam and determine the outpatient copay rate.
"RTN","IBECEA33",23,0)
I $$CNP^IBECEAU(DFN,IBFR) D I IBY<0 G OPTQ
"RTN","IBECEA33",24,0)
.N DIR,DIRUT,DUOUT,DTOUT,Y
"RTN","IBECEA33",25,0)
.W !!,"This patient had a Compensation & Pension exam on this date."
"RTN","IBECEA33",26,0)
.S DIR(0)="Y",DIR("A")="Do you still want to add a charge"
"RTN","IBECEA33",27,0)
.S DIR("?")="Enter 'Y' to continue to add the charge, or 'N' or '^' to quit"
"RTN","IBECEA33",28,0)
.D ^DIR S:'Y IBY=-1
"RTN","IBECEA33",29,0)
;
"RTN","IBECEA33",30,0)
N IBDT,IBX,IBBS,IBTYPE
"RTN","IBECEA33",31,0)
S (IBDT,IBTO)=IBFR,IBX="O",(IBTYPE,IBUNIT)=1,IBEVDA="*"
"RTN","IBECEA33",32,0)
D:$G(IBATYP)=74 CHRG^IBECEAU5 D:$G(IBATYP)'=74 TYPE^IBAUTL2
"RTN","IBECEA33",33,0)
D CTBB^IBECEAU3:IBY>0
"RTN","IBECEA33",34,0)
OPTQ Q
"RTN","IBECEA33",35,0)
;
"RTN","IBECEA33",36,0)
CHTYP ; Ask for the Charge Type
"RTN","IBECEA33",37,0)
;*** IB*2.0*618 add check for inactive field when building the list of Action Types.
"RTN","IBECEA33",38,0)
S DIC="^IBE(350.1,",DIC(0)="AEMQZ",D="E",DIC("S")="I '$P($G(^(0)),U,12),$P(^(0),U)'[""MEDICARE"",$P(^(0),U)'[""CHAMPVA SUB""",DIC("A")="Select CHARGE TYPE: "
"RTN","IBECEA33",39,0)
D IX^DIC K DIC S IBATYP=+Y I Y<0 S IBY=-1 W !!,"No CHARGE TYPE entered - transaction cannot be completed." G CHTYPQ
"RTN","IBECEA33",40,0)
;
"RTN","IBECEA33",41,0)
; - perform charge type edits
"RTN","IBECEA33",42,0)
S IBSEQNO=$P(Y(0),"^",5),IBXA=$P(Y(0),"^",11),IBNH=$S(IBXA=1:2,IBXA=9&(Y(0)["FEE"):2,1:$P(Y(0),"^",8)["NHCU")
"RTN","IBECEA33",43,0)
;
"RTN","IBECEA33",44,0)
;IB*2.0*646 Start
"RTN","IBECEA33",45,0)
;If the action type is DG FEE SERVICE (OPT) its an urgent care visit now and all eligibility checks and clocks can be skipped.
"RTN","IBECEA33",46,0)
; will convert to new Urgent Care Action type(s) in a future patch
"RTN","IBECEA33",47,0)
I $P(Y(0),U)="DG FEE SERVICE (OPT) NEW" S IBUC=1 G CHTYPQ
"RTN","IBECEA33",48,0)
;end IB*2.0*646
"RTN","IBECEA33",49,0)
;
"RTN","IBECEA33",50,0)
I 'IBSEQNO S IBY="-1^IB023" G CHTYPQ
"RTN","IBECEA33",51,0)
I IBXA=7 G CHTYPQ
"RTN","IBECEA33",52,0)
I IBXA=6 G:IBCVAEL CHTYPQ W !!,"This patient does not have a Primary Eligibility of CHAMPVA.",! G CHTYP
"RTN","IBECEA33",53,0)
I 'IBCATC,IBXA'=5,IBXA'=8,IBXA'=9 W !!,"This patient has never been Means Test billable...",!,"You may only select a Pharmacy copay charge type.",! G CHTYP
"RTN","IBECEA33",54,0)
I +IBEXSTAT,IBXA=5 W !!,"Patient is Exempt from Medication Copayment",!,$P(IBEXSTAT,"^",4),! G CHTYP
"RTN","IBECEA33",55,0)
I IBLTCST=0,IBXA>7,IBXA<10 W !!,"This patient has no LTC (1010EC) information on file.",!,"You cannot select a LTC charge type.",! G CHTYP
"RTN","IBECEA33",56,0)
I +IBLTCST=1,IBXA>7,IBXA<10 W !!,"This patient is Exempt from LTC Charges.",! G CHTYP
"RTN","IBECEA33",57,0)
S:IBXA=2 IBBS=$O(^DGCR(399.1,"AC",IBATYP,0))
"RTN","IBECEA33",58,0)
I IBXA=3 D
"RTN","IBECEA33",59,0)
.N DIR,DIRUT,DTOUT,DUOUT,DIROUT,TYPE
"RTN","IBECEA33",60,0)
.S TYPE=$S(Y(0,0)["NHCU PER DIEM":"N",1:"H")
"RTN","IBECEA33",61,0)
.S DIR(0)="Y",DIR("A")=" Is this charge for a "_$S(TYPE="N":"CNH",1:"Contract Hospital")_" admission",DIR("B")="NO"
"RTN","IBECEA33",62,0)
.S DIR("?")="Enter '<CR>' if the charge is for a VA "_$S(TYPE="N":"NHCU",1:"Hospital")_" admission, 'Y' for a "_$S(TYPE="N":"CNH",1:"Contract Hospital")_" admission, or '^' to quit."
"RTN","IBECEA33",63,0)
.W ! D ^DIR I $D(DIRUT)!$D(DUOUT) S IBY=-1 Q
"RTN","IBECEA33",64,0)
.I Y S IBNH=2
"RTN","IBECEA33",65,0)
I IBXA>7,IBXA<10,IBNH'=2 S IBNH=3
"RTN","IBECEA33",66,0)
CHTYPQ Q
"RTN","IBECEA33",67,0)
;
"RTN","IBECEA33",68,0)
CLMSG ; Check the Medicare Deductible and Billing Clock
"RTN","IBECEA33",69,0)
I 'IBMED S IBCLDT=IBFR D DED^IBAUTL3 I IBY<0 D NODED^IBECEAU3 G CLMSGQ
"RTN","IBECEA33",70,0)
I "^1^2^"[("^"_IBXA_"^"),IBCLDA,IBFR'<IBCLDT,IBCLDOL'<IBMED S IBY=-1 D
"RTN","IBECEA33",71,0)
.W !!?5,*7,"This patient has already been billed the Medicare Deductible ($",IBMED,")"
"RTN","IBECEA33",72,0)
.W !?5,"for his current 90 days of care. If you know this not to be the case,"
"RTN","IBECEA33",73,0)
.W !?5,"please adjust the billing clock before proceeding."
"RTN","IBECEA33",74,0)
CLMSGQ Q
"RTN","IBECEA36")
0^4^B539878
"RTN","IBECEA36",1,0)
IBECEA36 ;ALB/CPM-Cancel/Edit/Add... Urgent Care Add Utilities ; 23-APR-93
"RTN","IBECEA36",2,0)
;;2.0;INTEGRATED BILLING;**646**;21-MAR-94;Build 4
"RTN","IBECEA36",3,0)
;;Per VA Directive 6402, this routine should not be modified.
"RTN","IBECEA36",4,0)
;
"RTN","IBECEA36",5,0)
;DBIA #2918 - PRIORITY^DGENA call
"RTN","IBECEA36",6,0)
;
"RTN","IBECEA36",7,0)
UCCHRG ; Process Urgent Care Copay Charge
"RTN","IBECEA36",8,0)
; set the initial charge to $30
"RTN","IBECEA36",9,0)
; Undeclared parameters
"RTN","IBECEA36",10,0)
; IBFEE - Flag for Community Care Copays
"RTN","IBECEA36",11,0)
; IBUNIT - (Default 1) # units for the charge
"RTN","IBECEA36",12,0)
; IBCHG - Default Copay to charge
"RTN","IBECEA36",13,0)
; DFN - Patient IEN
"RTN","IBECEA36",14,0)
;
"RTN","IBECEA36",15,0)
;N IBPRI
"RTN","IBECEA36",16,0)
S IBCHG=30,IBUNIT=1 ;initial copay amount
"RTN","IBECEA36",17,0)
S (IBDT,IBTO)=IBFR,IBX="O",(IBTYPE,IBUNIT)=1,IBEVDA="*"
"RTN","IBECEA36",18,0)
;
"RTN","IBECEA36",19,0)
; Ask for other UC copays for the year that are not at this site (future development)
"RTN","IBECEA36",20,0)
;
"RTN","IBECEA36",21,0)
; Retrieve Priority Group (future development)
"RTN","IBECEA36",22,0)
;S IBPRI=$$PRIORITY^DGENA(DFN)
"RTN","IBECEA36",23,0)
;
"RTN","IBECEA36",24,0)
; If priority group 1-5, check total entries. If <4, then print exemption message and quit
"RTN","IBECEA36",25,0)
;
"RTN","IBECEA36",26,0)
; Call CTBB^IBECEAU3 to confirm or substitute amount of Copay
"RTN","IBECEA36",27,0)
D CTBB^IBECEAU3
"RTN","IBECEA36",28,0)
;
"RTN","IBECEA36",29,0)
Q
"RTN","IBECEAU2")
0^6^B34502641
"RTN","IBECEAU2",1,0)
IBECEAU2 ;ALB/CPM-Cancel/Edit/Add... User Prompts ; 19-APR-93
"RTN","IBECEAU2",2,0)
;;2.0;INTEGRATED BILLING;**7,52,153,176,545,563,614,618,646**;21-MAR-94;Build 4
"RTN","IBECEAU2",3,0)
;;Per VA Directive 6402, this routine should not be modified.
"RTN","IBECEAU2",4,0)
;
"RTN","IBECEAU2",5,0)
REAS(IBX) ; Ask for the cancellation reason.
"RTN","IBECEAU2",6,0)
; Input: IBX -- "C" (Cancel a charge), "E" (Edit a Charge)
"RTN","IBECEAU2",7,0)
S DIC="^IBE(350.3,",DIC(0)="AEMQZ",DIC("A")="Select "_$S(IBX="E":"EDIT",1:"CANCELLATION")_" REASON: "
"RTN","IBECEAU2",8,0)
S DIC("S")=$S(IBXA=7:"I 1",IBXA=6:"I $P(^(0),U,3)=3",IBXA=5:"I ($P(^(0),U,3)=1)!($P(^(0),U,3)=3)",1:"I ($P(^(0),U,3)=2)!($P(^(0),U,3)=3)")
"RTN","IBECEAU2",9,0)
D ^DIC K DIC S IBCRES=+Y I Y<0 W !!,"No ",$S(IBX="E":"edit",1:"cancellation")," reason entered - the transaction cannot be completed."
"RTN","IBECEAU2",10,0)
Q
"RTN","IBECEAU2",11,0)
;
"RTN","IBECEAU2",12,0)
UNIT(DEF) ; Ask for units for Rx copay charges
"RTN","IBECEAU2",13,0)
; Input: DEF -- Default value if previous charge is to be displayed
"RTN","IBECEAU2",14,0)
N DA,DIR,DIRUT,DUOUT,DTOUT,X,X1,Y
"RTN","IBECEAU2",15,0)
S DA=IBATYP,IBDESC="RX COPAYMENT" D COST^IBAUTL S IBCHG=X1
"RTN","IBECEAU2",16,0)
; IB*2.0*614
"RTN","IBECEAU2",17,0)
; Check for HRfS flag and days supply, if flag and days supply is less than 30 prorate cost
"RTN","IBECEAU2",18,0)
I $$CHKHRFS^IBAMTS3(DFN,IBEFDT) N IBSUPP D ;Pt has the HRfS active flag
"RTN","IBECEAU2",19,0)
. N DA,DIR,DIRUT,DUOUT,DTOUT,X,X1,Y
"RTN","IBECEAU2",20,0)
. S DIR("0")="N^1:90",DIR("?")="Enter a whole number between 1 and 90",DIR("A")="DAYS SUPPLY",DIR("B")=30
"RTN","IBECEAU2",21,0)
. D ^DIR I 'Y!($D(DIRUT))!($D(DUOUT)) Q
"RTN","IBECEAU2",22,0)
. I $G(Y)>29 Q ;Quit if day supply is not less than 30
"RTN","IBECEAU2",23,0)
. S IBCHG=$$PRORATE^IBAMTS3(Y,IBCHG) ;Prorate the cost as per regulation
"RTN","IBECEAU2",24,0)
; END OF IB*2.0*614 changes
"RTN","IBECEAU2",25,0)
S DIR(0)="N^::0^K:X<1!(X>12) X",DIR("A")="Units",DIR("?")="^D HUN^IBECEAU2"
"RTN","IBECEAU2",26,0)
S:DEF DIR("B")=DEF D ^DIR I Y S IBUNIT=Y,IBCHG=IBCHG*Y
"RTN","IBECEAU2",27,0)
I 'Y W !!,"Units not entered - transaction cannot be completed." S IBY=-1
"RTN","IBECEAU2",28,0)
Q
"RTN","IBECEAU2",29,0)
;
"RTN","IBECEAU2",30,0)
FR(DEF) ; Ask Bill From Date
"RTN","IBECEAU2",31,0)
; Input: DEF -- Default value if previous charge is to be displayed
"RTN","IBECEAU2",32,0)
N DA,DIR,DIRUT,DUOUT,DTOUT,X,X1,Y
"RTN","IBECEAU2",33,0)
FRA S:$G(DEF) DIR("B")=$$DAT2^IBOUTL(DEF)
"RTN","IBECEAU2",34,0)
S DIR(0)="DA^2901001:"_IBLIM_":EX",DIR("A")=$S(IBXA=4!(IBXA=7):"Visit Date: ",IBXA=5:"Rx Date: ",1:"Charge for services from: "),DIR("?")="^D HFR^IBECEAU2"
"RTN","IBECEAU2",35,0)
D ^DIR K DIR S IBFR=Y I 'Y W !!,$S(IBXA=4!(IBXA=7):"Visit",IBXA=5:"Rx",1:"Bill From")," Date not entered - transaction cannot be completed." S IBY=-1 G FRQ
"RTN","IBECEAU2",36,0)
I IBXA=7 G FRQ
"RTN","IBECEAU2",37,0)
I IBXA'=8,IBXA'=9,IBXA'=5,'IBUC,'$$BIL^DGMTUB(DFN,IBFR+.24) D CATC G FRA ;IB*2.0*646 - added UC check.
"RTN","IBECEAU2",38,0)
I IBXA>7,IBXA<10,$$LTCST^IBAECU(DFN,IBFR,1)<2 W !,"This patient is not LTC billable on this date.",! G FRA
"RTN","IBECEAU2",39,0)
I IBXA=4,$$BFO^IBECEAU(DFN,IBFR) W !!,"This patient has already been billed the outpatient copay charge for ",$$DAT1^IBOUTL(IBFR),".",! G FRA
"RTN","IBECEAU2",40,0)
FRQ Q
"RTN","IBECEAU2",41,0)
;
"RTN","IBECEAU2",42,0)
TO(DEF) ; Ask Bill To Date
"RTN","IBECEAU2",43,0)
; Input: DEF -- Default value if previous charge is to be displayed
"RTN","IBECEAU2",44,0)
N DA,DIR,DIRUT,DUOUT,DTOUT,X,X1,Y
"RTN","IBECEAU2",45,0)
TOA S:$G(DEF) DIR("B")=$$DAT2^IBOUTL(DEF)
"RTN","IBECEAU2",46,0)
S DIR(0)="DA^"_IBFR_":"_IBLIM_":EX",DIR("A")=" Charge for services to: ",DIR("?")="^D HTO^IBECEAU2"
"RTN","IBECEAU2",47,0)
D ^DIR K DIR S IBTO=Y I 'Y W !!,"Bill To date not entered - transaction cannot be completed." S IBY=-1 G TOQ
"RTN","IBECEAU2",48,0)
I IBTO'=IBFR,'$$BIL^DGMTUB(DFN,$S(IBXA=3&'$G(DEF):$$FMADD^XLFDT(IBTO,-1),1:IBTO)+.24),IBXA'=8,IBXA'=9 D CATC G TOA
"RTN","IBECEAU2",49,0)
TOQ Q
"RTN","IBECEAU2",50,0)
;
"RTN","IBECEAU2",51,0)
FEE(DEF) ; Ask for Fee Amount
"RTN","IBECEAU2",52,0)
; Input: DEF -- Default value if previous charge is to be displayed
"RTN","IBECEAU2",53,0)
N DIR,DIRUT,DUOUT,DTOUT,X,Y
"RTN","IBECEAU2",54,0)
S:$G(DEF) DIR("B")=DEF
"RTN","IBECEAU2",55,0)
S DIR(0)="NA^::2^K:X<0!(X>(IBMED-IBCLDOL)) X",DIR("A")=" Fee Amount: ",DIR("?")="^D HFEE^IBECEAU2"
"RTN","IBECEAU2",56,0)
D ^DIR S IBCHG=Y I 'Y W !!,"Charge not entered - transaction cannot be completed." S IBY=-1
"RTN","IBECEAU2",57,0)
Q
"RTN","IBECEAU2",58,0)
;
"RTN","IBECEAU2",59,0)
AMT ; Ask for Charge Amount
"RTN","IBECEAU2",60,0)
N DIR,DIRUT,DUOUT,DTOUT,X,Y
"RTN","IBECEAU2",61,0)
S DIR(0)="NA^::2^K:X<0!(X>99999) X",DIR("A")="Charge Amount: ",DIR("?")="^D HAMT^IBECEAU2"
"RTN","IBECEAU2",62,0)
D ^DIR S IBCHG=Y I 'Y W !!,"Charge not entered - transaction cannot be completed." S IBY=-1
"RTN","IBECEAU2",63,0)
Q
"RTN","IBECEAU2",64,0)
;
"RTN","IBECEAU2",65,0)
CATC ; Display that patient is not Means Test billable.
"RTN","IBECEAU2",66,0)
W !!,"The patient ",$S(IBFR<DT:"was",1:"is")," not Means Test billable on this date.",!
"RTN","IBECEAU2",67,0)
Q
"RTN","IBECEAU2",68,0)
;
"RTN","IBECEAU2",69,0)
HUN ; Help for units
"RTN","IBECEAU2",70,0)
W !!,"Please enter 1, 2, 3, ...,12 to denote a 30, 60, 90, ...,360 days supply of"
"RTN","IBECEAU2",71,0)
W !,"medication, or '^' to quit."
"RTN","IBECEAU2",72,0)
Q
"RTN","IBECEAU2",73,0)
;
"RTN","IBECEAU2",74,0)
HFR ; Help for Bill From date
"RTN","IBECEAU2",75,0)
W !!,"Please enter the ",$S(IBXA=4!(IBXA=7):"patient's outpatient visit date",IBXA=5:"patient's prescription date",1:"'Bill From' date for this charge"),$S(IBXA'=5:", which must follow",1:"")
"RTN","IBECEAU2",76,0)
W !,$S(IBXA=5:"today or prior to today",1:"10/1/90"_$S(IBXA=4!(IBXA=7):"",1:" (and be prior to today)")),", or '^' to quit."
"RTN","IBECEAU2",77,0)
Q
"RTN","IBECEAU2",78,0)
;
"RTN","IBECEAU2",79,0)
HTO ; Help for Bill To date
"RTN","IBECEAU2",80,0)
W !!,"Please enter the 'Bill To' date for this charge, which may not precede"
"RTN","IBECEAU2",81,0)
W !,$$DAT1^IBOUTL(IBFR),", or '^' to quit."
"RTN","IBECEAU2",82,0)
Q
"RTN","IBECEAU2",83,0)
;
"RTN","IBECEAU2",84,0)
HFEE ; Help for Fee Amount
"RTN","IBECEAU2",85,0)
W !!,"Please enter the charge for this Fee Service, which may not be greater than"
"RTN","IBECEAU2",86,0)
W !,"the difference between the Medicare Deductible amount and the "
"RTN","IBECEAU2",87,0)
W $$INPT^IBECEAU(IBCLDAY)," 90 days",!,"copay billed ($",IBMED-IBCLDOL,"), or '^' to quit."
"RTN","IBECEAU2",88,0)
Q
"RTN","IBECEAU2",89,0)
;
"RTN","IBECEAU2",90,0)
HAMT ; Help for Charge Amount
"RTN","IBECEAU2",91,0)
W !!,"Please enter the charge for this copayment."
"RTN","IBECEAU2",92,0)
Q
"RTN","IBECEAU2",93,0)
;
"RTN","IBECEAU2",94,0)
TIER(IBATYP,IBEFDT,TIER) ; Prompt if needed for copay tier
"RTN","IBECEAU2",95,0)
; IBATYP - 350.1 IB Action Type
"RTN","IBECEAU2",96,0)
; IBEFDT - Date for possible tier choice or not if only one tier available
"RTN","IBECEAU2",97,0)
; TIER - {optional) default tier, if none specified, then 2 used
"RTN","IBECEAU2",98,0)
N IB,IBN,IBD,IBEND,IBFTIER,IBLTIER,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,DIR,IBTIER
"RTN","IBECEAU2",99,0)
S IBD=-($G(IBEFDT,DT)+.9),IBD=$O(^IBE(350.2,"AIVDT",IBATYP,IBD)),IBEND=$O(^IBE(350.2,"AIVDT",IBATYP,IBD))
"RTN","IBECEAU2",100,0)
I IBD="" D Q 0
"RTN","IBECEAU2",101,0)
. W !!,"Rx Date entered is invalid for the charge type. Please confirm",!
"RTN","IBECEAU2",102,0)
. W "the date and re-enter."
"RTN","IBECEAU2",103,0)
. S IBY=-1
"RTN","IBECEAU2",104,0)
S IBEND=$O(^IBE(350.2,"AIVDT",IBATYP,IBD))
"RTN","IBECEAU2",105,0)
S IBN=0 F S IBN=$O(^IBE(350.2,"AIVDT",IBATYP,IBD,IBN)) Q:'IBN S IB=$G(^IBE(350.2,IBN,0)) I IB]"",'$P(IB,"^",5)!($P(IB,"^",5)>IBEFDT) S IBTIER($P(IB,"^",7))=""
"RTN","IBECEAU2",106,0)
; if only one tier don't prompt just use it
"RTN","IBECEAU2",107,0)
S IBFTIER=$O(IBTIER(0)) I '$O(IBTIER(IBFTIER)) Q IBFTIER
"RTN","IBECEAU2",108,0)
S IBLTIER=$O(IBTIER(1000),-1)
"RTN","IBECEAU2",109,0)
S DIR(0)="N^"_IBFTIER_":"_IBLTIER_":0"
"RTN","IBECEAU2",110,0)
S DIR("A")="ENTER THE COPAY TIER"
"RTN","IBECEAU2",111,0)
S DIR("B")=$S($G(TIER):TIER,1:2)
"RTN","IBECEAU2",112,0)
S DIR("?")="Enter the copayment tier for this charge, it will be used to determine the per unit rate."
"RTN","IBECEAU2",113,0)
D ^DIR
"RTN","IBECEAU2",114,0)
I $D(DIRUT) S IBY=-1 Q 0
"RTN","IBECEAU2",115,0)
Q Y
"VER")
8.0^22.2
**END**
**END**