11. EPMO Open Source Coordination Office Redaction File Detail Report

Produced by Araxis Merge on 2/15/2018 4:26:16 PM Eastern Standard Time. See www.araxis.com for information about Merge. This report uses XHTML and CSS2, and is best viewed with a modern standards-compliant browser. For optimum results when printing this report, use landscape orientation and enable printing of background images and colours in your browser.

11.1 Files compared

#	Location	File	Last Modified
1	eBilling_Bld22_IB_2_608.zip	TAS eBill SDD US2489 v2.00.docx	Tue Dec 19 21:52:48 2017 UTC
2	eBilling_Bld22_IB_2_608.zip	TAS eBill SDD US2489 v2.00.docx	Thu Feb 15 18:18:54 2018 UTC

11.2 Comparison summary

Description	Between Files 1 and 2
Description	Text Blocks	Lines
Unchanged	1	4140
Changed	0	0
Inserted	0	0
Removed	0	0

11.3 Comparison options

Whitespace
Character case	Differences in character case are significant
Line endings	Differences in line endings (`CR` and `LF` characters) are ignored
CR/LF characters	Not shown in the comparison detail

11.4 Active regular expressions

No regular expressions were active.

11.5 Comparison detail

	1	TAS eBilli ng SDD US2 489
	2	System Des ign Docume nt
	3	IB2.0592
	4
	5
	6
	7
	8	Department of Vetera ns Affairs
	9	July 2017
	10	Version 2. 00
	11	User Story Number: N O ID
	12	User Story Name: Fix <UNDEFINE D> errors
	13	Product Ba cklog ID: n/a
	14	Rally ID: US-2489
	15	Design/Res olution
	16	This SDD i s to fix t wo <UNDEFI NED> error s intermit tently occ urring whe n the user tries to 1) “Print MRA” while in the MR A Manageme nt WorkLis t, which i s error <U NDEFINED>P MRA+3^IBCE COB2 and 2 ) “CANCEL/ CLONE” a b ill, which is error <UNDEFINED >STEP1+5^I BCCC.
	17	This fix r equires mo difying 4 routines, namely IBC C, IBCCC, IBCCCB and IBCECOB2 as summari zed and de tailed bel ow:
	18	Error #1 <UNDEFINED >PMRA+3^IB CECOB2: Th is simply requires t he use of $G to wrap an array element be ing refere nced in PM RA^IBCECOB 2 that was $G’d at a previous command in the same line of co de.
	19
	20	Error #2 <UNDEFINED >STEP1+5^I BCCC: Is d irectly ca used by th e killing of a criti cal variab le IBCCCC which is s ubsequentl y referenc ed. It is being sub sequently referenced because t he logic i s caught i n an endle ss loop du e to the f act that t he quit fl ag IBQUIT is not bei ng flagged as ‘1’ af ter issuin g a messag e directin g the user to anothe r activity . To reso lve this e rror, the code at ST EP1^IBCCC shall be m odified to wrap vari able IBCCC C with $G to prevent any futur e <UNDEFIN ED> errors at this p lace in th e code. W rapping IB CCC with $ G, is real ly a fails afe since IBCCC shou ld no long er be unde fined at t his point due to the changes t o END1^IBC CC, which shall be m odified so that the killing of IBCCC occ urs after the loopba ck to STEP 1 instead of prior t o the loop back. The root caus e of this error, how ever, shal l be addre ssed by mo difying ro utines IBC C and IBCC CB to prop erly set t he IBQUIT flag after issuing t he message directing the user to another activity.
	21
	22	Routines
	23	Activities
	24	Routine Na me
	25	IBCC
	26	Enhancemen t Category
	27	New
	28	Modify
	29	Delete
	30	No Change
	31	RTM
	32
	33	Related Op tions
	34	None
	35	Related Ro utines
	36	Routines “ Called By”
	37	Routines “ Called”
	38
	39
	40
	41
	42	Data Dicti onary (DD) Reference s
	43
	44	Related Pr otocols
	45
	46	Related In tegration Control Re gistration s (ICRs)
	47	None
	48	Data Passi ng
	49	Input
	50	Output Re ference
	51	Both
	52	Global Re ference
	53	Local
	54	Input Attr ibute Name and Defin ition
	55	Name:
	56	Definition :
	57	Output Att ribute Nam e and Defi nition
	58	Name:
	59	Definition :
	60	Current Lo gic
	61	IBCC^INT^1 ^^0
	62	IBCC ;ALB/ MJB - CANC EL THIRD P ARTY BILL ;14 JUN 88 10:12
	63	;;2.0;INT EGRATED BI LLING;2, 19,77,80,5 1,142,137, 161,199,24 1,155,276, 320,358,43 3,432,447, 516,547; 21-MAR-94; Build 119
	64	;;Per VA Directive 6402, this routine s hould not be modifie d.
	65	;
	66	;MAP TO D GCRC
	67	;
	68	I '$D(IBC AN) S IBCA N=1
	69	ASK ;
	70	;***
	71	;I $D(XRT 0) S:'$D(X RTN) XRTN= "IBCC" D T 1^%ZOSV ;s top rt clo ck
	72	;S XRTL=$ ZU(0),XRTN ="IBCC-1" D T0^%ZOSV ;start rt clock
	73	;
	74	; If call ed at entr y point PR OCESS, var iable IBNO ASK will e xist.
	75	; First t ime throug h, IBNOASK =1
	76	; Second time throu gh, IBNOAS K=2 and it will quit
	77	I $G(IBNO ASK)=2 G Q
	78	I $G(IBNO ASK)=1 S I BNOASK=2
	79	;
	80	G Q:$G(IB CE("EDI"))
	81	D Q
	82	S IBQUIT= 0
	83	N DPTNOFZ Y S DPTNOF ZY=1 ;Sup press PATI ENT file f uzzy looku ps
	84	I '$G(IBN OASK) S DI C="^DGCR(3 99,",DIC(0 )="AEMQZ", DIC("A")=" Enter BILL NUMBER or Patient N AME: " W ! ! D ^DIC I Y<1 S IBQ UIT=1 G Q1
	85	K IB364
	86	NOPTF ; No te if IB36 4 is >0 it will be u sed as the ien to up date in fi le 364
	87	N DA,I
	88	I '$G(IBN OASK) S IB IFN=+$G(Y)
	89	I '$G(IBI FN) G ASK
	90	I IBCAN>1 D NOPTF^I BCB2 I 'IB AC1 D NOPT F1^IBCB2 G ASK
	91	;
	92	I $G(IBCN CRD)=1,$P( $P($G(^DGC R(399,IBIF N,0)),U)," -",2)>98 D Q
	93	.W !!,"Pl ease note that you h ave exceed ed the max imum numbe r of itera tions (99) for this claim."
	94	.W "Copy and cancel (CLON) mu st be used to correc t this bil l."
	95	.S IBQUIT =1 H 3
	96	; Check i f bill has been refe rred to Co unsel
	97	I $P($G(^ PRCA(430,I BIFN,6)),U ,4) D G A SK
	98	. W !,"Th is bill ha s been ref erred to R egional Co unsel and cannot be 'CANCELLED ' in"
	99	. W !,"In tegrated B illing. P lease use the option 'TP Refer red Follow -up'"
	100	. W !,"[P RCA RC ACT ION MENU] in Account s Receivab le to requ est that R egional"
	101	. W !,"Co unsel retu rn the bil l to your facility."
	102	. Q
	103	;
	104	F I=0,"S" ,"U1" S IB (I)=$G(^DG CR(399,IBI FN,I))
	105	S IBSTAT= $P(IB(0),U ,13)
	106	; REMOVE New messag es for CRD option IB 2.0433 i n IB2.04 47 IA#563 0
	107	;I $G(IBC NCRD)=1,IB STAT'=2,'$ $ACCK^PRCA ACC(IBIFN) D Q
	108	;.W !!,"T his option cannot be used to c orrect som e Billing Rate Types (Example: TRICARE)"
	109	;.W "Copy and cance l (CLON) m ust be use d to corre ct this bi ll."
	110	;.S IBQUI T=1 H 3
	111	;
	112	; Restric t access t o this pro cess for R EQUEST MRA bills
	113	I IBSTAT= 2,'$G(IBCE ("EDI")),$ $MRAWL^IBC EMU2(IBIFN ) D G ASK
	114	. W !!?4, "This bill is in a s tatus of R EQUEST MRA and it do es appear on the"
	115	. W !?4," MRA Manage ment Work List. Ple ase use th e 'MRA Man agement Me nu' option s"
	116	. W !?4," for all pr ocessing r elated to this bill. "
	117	. Q
	118	;
	119	; IB2.0 432 Restri ct access to claims on the new CBW Workl ist
	120	I $P($G(^ DGCR(399,I BIFN,"S1") ),U,7)=1,$ G(IBMRANOT )'=1 D G ASK
	121	. W !!?4, "This bill appears o n the CBW Management Work List . Please use the"
	122	. W !?4," 'CBW Manag ement Menu ' options for all pr ocessing r elated to this bill. "
	123	. Q
	124	;
	125	; Check i f this is a paper cl aim. If no t, check f or split E OB. If sp lit, don't allow CRD unless mo re than 1 EOB has be en returne d
	126	I $G(IBCN CRD)=1,$P( $G(^DGCR(3 99,IBIFN," TX")),U,8) '=1,$$SPLT MRA^IBCEMU 1(IBIFN)=1 D Q
	127	.W !!,"Th ere is a s plit EOB a ssociated with this claim. Yo u cannot u se this op tion to Co rrect this claim unt il the sec ond EOB ha s been rec eived."
	128	.S IBQUIT =1 H 3
	129	.Q
	130	;
	131	; Warning message i f in a REQ UEST MRA s tatus with no MRA on file
	132	; IB2.0 516/TAZ,MR D - Forbid the user from using the optio n CRD
	133	; (Correc t Rejected /Denied Bi ll) on an MRA claim if the sta tus is
	134	; REQUEST MRA (IBST AT=2).
	135	I IBSTAT= 2,'$$MRACN T^IBCEMU1( IBIFN) D I $G(IBQUI T) H 3 Q
	136	. N REJ
	137	. D TXSTS ^IBCEMU2(I BIFN,,.REJ )
	138	. ;IB2.0 516/TAZ - If CRD is from CSA allow a RE Jected cla im to be C RD'ed with out displa ying a war ning.
	139	. I $G(IB CNCSA),REJ Q
	140	. W *7,!! ?4,$S('$G( IBCNCRD):" Warning! ",1:""),"T his bill i s in a sta tus of REQ UEST MRA."
	141	. W !?4," No MRAs ha ve been re ceived"
	142	. I REJ W ", but th e most rec ent transm ission of this",!?4, "MRA reque st bill wa s rejected ."
	143	. I 'REJ W " and th ere are no rejection messages on file",! ?4,"for th e most rec ent transm ission of this MRA r equest bil l."
	144	. I $G(IB CNCRD) S I BQUIT=1
	145	. Q
	146	;
	147	I IBCAN=2 ,IB("S")]" ",+$P(IB(" S"),U,16), $P(IB("S") ,U,17)]"" D G 1
	148	. W !!,"T his bill w as cancell ed on " S Y=$P(IB("S "),U,17) X ^DD("DD") W Y," by ",$S($P(IB ("S"),U,18 )']"":IBU, $D(^VA(200 ,$P(IB("S" ),U,18),0) ):$P(^(0), U,1),1:IBU ),"."
	149	. S IBQUI T=1
	150	;
	151	; IB2.0 516/TAZ,MR D - Forbid the user from using the optio n CRD
	152	; (Correc t Rejected /Denied Bi ll) on all but prima ry claims.
	153	I $G(IBCN CRD),($$CO B^IBCEF(IB IFN)'="P") D Q
	154	. W !!,"P lease note that COB data may e xist for t his bill."
	155	. W !,"Co py and can cel (CLON) must be u sed to cor rect this bill."
	156	. S IBQUI T=1
	157	. H 3
	158	. Q
	159	;
	160	; Notify if a payme nt has bee n posted t o this bil l before c ancel
	161	N PRCABIL L
	162	S PRCABIL L=$$TPR^PR CAFN(IBIFN )
	163	I PRCABIL L=-1 W !!, "Please no te: PRCA w as unable to determi ne if a pa yment has been poste d." I $G(I BCNCRD)=1 W !,"Copy and cancel (CLON) mu st be used to correc t this bil l." S IBQU IT=1 H 3 Q
	164	I PRCABIL L>0 W !!," Please not e a PAYMEN T of $"_ $$TPR^PRCA FN(IBIFN)_ " has be en POSTED to this bi ll."
	165	; New mes sage for C RD option
	166	I $G(IBCN CRD)=1,PRC ABILL>0 W !,"Copy an d cancel ( CLON) must be used t o correct this bill. " S IBQUIT =1 H 3 Q
	167	;
	168	; If bill was creat ed via Ele ctronic cl aims proce ss then no tify
	169	; user th at cancell ation shou ld occur u sing ECME package
	170	I $$GET1^ DIQ(399,IB IFN_",",46 0)]"" D G :'Y ASK
	171	. W !!!?5 ,"This bil l was crea ted by the "
	172	. W !?5," Electronic Claims Ma nagement E ngine (ECM E)."
	173	. W !?5," Cancellati on needs t o occur in the ECME package by "
	174	. W !?5," submitting a REVERSA L to the P ayer.",!!
	175	. K DIR S DIR("A",1 )="Has a R EVERSAL fo r this e-C laim alrea dy been",D IR("A")="s ubmitted t o the paye r via the ECME packa ge (Y/N)", DIR(0)="Y" ,DIR("B")= "NO" D ^DI R
	176	. I Y=0 W !!,"<PLEA SE SUBMIT A REVERSAL USING THE APPROPRIA TE OPTION IN THE ECM E PACKAGE> ",$C(7)
	177	;
	178	CHK ;
	179	; if user came from CLON, mak e sure the y know abo ut the new CRD optio n IB2.0 447 remove TRICARE m sg.
	180	I $G(IBCN COPY)=1 D
	181	.W !!,*7, "Warning: This opti on should NOT be use d to corre ct Rejecte d/Denied c laims."
	182	.W !," It should ONL Y be used to correct DENIED cl aims which have paym ents"
	183	.W !," pos ted agains t them.*** " ; and cl aims with certain Bi lling Rate Types (Ex ample: TRI CARE)."
	184	;
	185	S (IBCCCC ,IBQUIT)=0 I '$G(IBC EAUTO),'$G (IBMCSCAN) W !!,"ARE YOU SURE YOU WANT T O CANCEL T HIS BILL" S %=2 D YN ^DICN G:%= 0 HELP I % '=1 S IBQU IT=1 G NO
	186	;
	187	I '$G(IBC EAUTO) W ! !,"LAST CH ANCE TO CH ANGE YOUR MIND..."
	188	S DIE=399 ,DA=IBIFN, DIE("NO^") =""
	189	S DR="16; S:'X Y=0;1 9;S IBCCCC =1;"
	190	I $G(IBCE AUTO) S DR ="16////1; 19////EDI/ MRA TURNED OFF;S IBC CCC=1;"
	191	;
	192	; esg - 8 /23/06 - I B2358 - fix semi-c olon in fr ee text fi eld
	193	I $G(IBMC SRSC)'="" S DR="16;S :'X Y=0;19 //^S X=IBM CSRSC;S IB CCCC=1;"
	194	D ^DIE K DIE,DR
	195	;
	196	NO I 'IBCC CC W !!,"< NO ACTION TAKEN>",*7 S IBQUIT= 1 G ASK:IB CAN<2,Q
	197	S IBCCR=$ P($G(^DGCR (399,IBIFN ,"S")),U,1 9)
	198	; update claim # wi th new ite ration IB 2.0447 m ove to lat er in the process
	199	;D:$G(IBC NCRD)=1 CR D
	200	W !!,"... Bill has b een cancel led..." D BULL^IBCBU LL,BSTAT^I BCDC(IBIFN ),PRIOR^IB CCC2(IBIFN )
	201	;
	202	; cancell ing in ing enix claim smanager i f ingenix is running
	203	; clean-u p of varia bles is OK if not co ming in fr om ListMan screen
	204	I $$CM^IB CIUT1(IBIF N) S IBCIS NT=4 D ST2 ^IBCIST I '$G(IBCICN CL) K IBCI SNT,IBCIST AT,IBCIRED T,IBCIERR
	205	;
	206	S IBEDI=$ G(IB364)
	207	I 'IBEDI S IBEDI=+$ $LAST364^I BCEF4(IBIF N)
	208	; ib2.0 547 don't cancel MRA if clonin g a bill t hat is sec ondary to MRA (share the same claim#)
	209	I IBEDI D UPDEDI^IB CEM(IBEDI, "C",,$S($$ MRASEC^IBC EF4(IBIFN) :2,1:"")) ;Update ED I files, i f needed
	210	;
	211	F I="S"," U1" S IB(I )=$S($D(^D GCR(399,IB IFN,I)):^( I),1:"")
	212	S PRCASV( "ARREC")=I BIFN,PRCAS V("AMT")=$ S(IB("U1") ']"":0,1:$ P(IB("U1") ,"^")),PRC ASV("DATE" )=$P(IB("S "),"^",17) ,PRCASV("B Y")=$P(IB( "S"),"^",1 8)
	213	S PRCASV( "COMMENT") =$S($P(IB( "S"),U,19) ]"":$P(IB( "S"),U,19) ,$P(^IBE(3 50.9,1,2), "^",7)]"": $P(^(2),"^ ",7),1:"BI LL CANCELL ED IN MAS" )
	214	S PRCASV( "BY")=$S($ P(IB("S"), U,18)]"":$ P(IB("S"), U,18),1:"" )
	215	; IA#3374 /IB2.043 3 Pass the CRD flag so FMS kno ws to send a cancel record bef ore the ne w E record is sent
	216	;S X=$$CA NCEL^RCBEI B($G(PRCAS V("ARREC") ),$G(PRCAS V("DATE")) ,$G(PRCASV ("BY")),$G (PRCASV("A MT")),$G(P RCASV("COM MENT")))
	217	S PRCASV( "ARCRD")=$ G(IBCNCRD)
	218	S X=$$CAN CEL^RCBEIB ($G(PRCASV ("ARREC")) ,$G(PRCASV ("DATE")), $G(PRCASV( "BY")),$G( PRCASV("AM T")),$G(PR CASV("COMM ENT")),$G( PRCASV("AR CRD")))
	219	W !,$S(X: ">> The re ceivable a ssociated with the c laim was c ancelled." ,1:">> The receivabl e associat ed with th e claim wa s not canc elled.")
	220	I $P(X,U, 2)]"" W !, ">>> ",$P( X,U,2) ; T he reason why the cl aim can no t be cance lled.
	221	I IBCAN<2 D RNB^IBC C1 ;assign a reason not billab le
	222	G ASK:IBC AN<2,Q
	223	;
	224	HELP W !,? 3,"Answer 'YES' or ' Y' if you wish to ca ncel this bill.",!,? 3,"Answer 'NO' or 'N ' if you w ant to abo rt." G CHK
	225	Q
	226	1 I $P(IB( 0),U,13)=1 W !,"This record wa s re-opene d on " S Y =$P(IB(0), U,14) X ^D D("DD") W Y,"." G CH K
	227	G ASK
	228	Q1 K:IBCAN =1 IBQUIT K IBCAN
	229	Q K %,IBEP AR,IBSTAT, IBARST,IBA C1,IB,DFN, IBX,IBZ,DI C,DIE,DR,P RCASV,PRCA SVC,X,Y,IB EDI
	230	;***
	231	;I $D(XRT 0) S:'$D(X RTN) XRTN= "IBCC" D T 1^%ZOSV ;s top rt clo ck
	232	Q
	233	CRD(IBIFN) ; entry t o point to add itera tion # to claim
	234	N IBFDA
	235	S IBITN=$ $ITN^IBCCC (IBIFN)
	236	S IBFDA(3 99,IBIFN_" ,",.01)=IB ITN
	237	D FILE^DI E("","IBFD A")
	238	; this wi ll re-open the claim , so reset to cancel led
	239	S DIE=399 ,DA=IBIFN
	240	S DR="16/ ///1"
	241	D ^DIE K DIE,DR
	242	Q
	243	;
	244	PROCESS(IB IFN,IBCAN) ;
	245	; Entry p oint when the bill n umber is a lready kno wn. Use t his when
	246	; you jus t want to try to can cel this b ill and th is bill on ly.
	247	; Input:
	248	; IBIFN - Interna l bill# (R equired)
	249	; IBCAN - Cancel Flag (opti onal, defa ults to 1 if not inc luded)
	250	;
	251	NEW IBNOA SK
	252	S IBNOASK =1
	253	S IBCAN=$ G(IBCAN,1)
	254	G ASK
	255	;
	256	;IBCC
	257	Modified L ogic (Chan ges are in bold)
	258	IBCC ;ALB/ MJB - CANC EL THIRD P ARTY BILL ;14 JUN 88 10:12
	259	;;2.0;INT EGRATED BI LLING;2, 19,77,80,5 1,142,137, 161,199,24 1,155,276, 320,358,43 3,432,447, 516,547; 21-MAR-94; Build 119
	260	;;Per VA Directive 6402, this routine s hould not be modifie d.
	261	;
	262	;MAP TO D GCRC
	263	;
	264	I '$D(IBC AN) S IBCA N=1
	265	ASK ;
	266	;***
	267	;I $D(XRT 0) S:'$D(X RTN) XRTN= "IBCC" D T 1^%ZOSV ;s top rt clo ck
	268	;S XRTL=$ ZU(0),XRTN ="IBCC-1" D T0^%ZOSV ;start rt clock
	269	;
	270	; If call ed at entr y point PR OCESS, var iable IBNO ASK will e xist.
	271	; First t ime throug h, IBNOASK =1
	272	; Second time throu gh, IBNOAS K=2 and it will quit
	273	I $G(IBNO ASK)=2 G Q
	274	I $G(IBNO ASK)=1 S I BNOASK=2
	275	;
	276	G Q:$G(IB CE("EDI"))
	277	D Q
	278	S IBQUIT= 0
	279	N DPTNOFZ Y S DPTNOF ZY=1 ;Sup press PATI ENT file f uzzy looku ps
	280	I '$G(IBN OASK) S DI C="^DGCR(3 99,",DIC(0 )="AEMQZ", DIC("A")=" Enter BILL NUMBER or Patient N AME: " W ! ! D ^DIC I Y<1 S IBQ UIT=1 G Q1
	281	K IB364
	282	NOPTF ; No te if IB36 4 is >0 it will be u sed as the ien to up date in fi le 364
	283	N DA,I
	284	I '$G(IBN OASK) S IB IFN=+$G(Y)
	285	I '$G(IBI FN) G ASK
	286	I IBCAN>1 D NOPTF^I BCB2 I 'IB AC1 D NOPT F1^IBCB2 G ASK
	287	;
	288	I $G(IBCN CRD)=1,$P( $P($G(^DGC R(399,IBIF N,0)),U)," -",2)>98 D Q
	289	.W !!,"Pl ease note that you h ave exceed ed the max imum numbe r of itera tions (99) for this claim."
	290	.W "Copy and cancel (CLON) mu st be used to correc t this bil l."
	291	.S IBQUIT =1 H 3
	292	; Check i f bill has been refe rred to Co unsel
	293	I $P($G(^ PRCA(430,I BIFN,6)),U ,4) D G A SK
	294	. W !,"Th is bill ha s been ref erred to R egional Co unsel and cannot be 'CANCELLED ' in"
	295	. W !,"In tegrated B illing. P lease use the option 'TP Refer red Follow -up'"
	296	. W !,"[P RCA RC ACT ION MENU] in Account s Receivab le to requ est that R egional"
	297	. W !,"Co unsel retu rn the bil l to your facility."
	298	. Q
	299	;
	300	F I=0,"S" ,"U1" S IB (I)=$G(^DG CR(399,IBI FN,I))
	301	S IBSTAT= $P(IB(0),U ,13)
	302	; REMOVE New messag es for CRD option IB 2.0433 i n IB2.04 47 IA#563 0
	303	;I $G(IBC NCRD)=1,IB STAT'=2,'$ $ACCK^PRCA ACC(IBIFN) D Q
	304	;.W !!,"T his option cannot be used to c orrect som e Billing Rate Types (Example: TRICARE)"
	305	;.W "Copy and cance l (CLON) m ust be use d to corre ct this bi ll."
	306	;.S IBQUI T=1 H 3
	307	;
	308	; Restric t access t o this pro cess for R EQUEST MRA bills
	309	I IBSTAT= 2,'$G(IBCE ("EDI")),$ $MRAWL^IBC EMU2(IBIFN ) D G ASK
	310	. W !!?4, "This bill is in a s tatus of R EQUEST MRA and it do es appear on the"
	311	. W !?4," MRA Manage ment Work List. Ple ase use th e 'MRA Man agement Me nu' option s"
	312	. W !?4," for all pr ocessing r elated to this bill. "
	313	. Q
	314	;
	315	; IB2.0 432 Restri ct access to claims on the new CBW Workl ist
	316	I $P($G(^ DGCR(399,I BIFN,"S1") ),U,7)=1,$ G(IBMRANOT )'=1 D G ASK
	317	. W !!?4, "This bill appears o n the CBW Management Work List . Please use the"
	318	. W !?4," 'CBW Manag ement Menu ' options for all pr ocessing r elated to this bill. "
	319	. S IBQUI T=1 ;JRA need to se t quit fla g after is suing this message
	320	. Q
	321	;
	322	; Check i f this is a paper cl aim. If no t, check f or split E OB. If sp lit, don't allow CRD unless mo re than 1 EOB has be en returne d
	323	I $G(IBCN CRD)=1,$P( $G(^DGCR(3 99,IBIFN," TX")),U,8) '=1,$$SPLT MRA^IBCEMU 1(IBIFN)=1 D Q
	324	.W !!,"Th ere is a s plit EOB a ssociated with this claim. Yo u cannot u se this op tion to Co rrect this claim unt il the sec ond EOB ha s been rec eived."
	325	.S IBQUIT =1 H 3
	326	.Q
	327	;
	328	; Warning message i f in a REQ UEST MRA s tatus with no MRA on file
	329	; IB2.0 516/TAZ,MR D - Forbid the user from using the optio n CRD
	330	; (Correc t Rejected /Denied Bi ll) on an MRA claim if the sta tus is
	331	; REQUEST MRA (IBST AT=2).
	332	I IBSTAT= 2,'$$MRACN T^IBCEMU1( IBIFN) D I $G(IBQUI T) H 3 Q
	333	. N REJ
	334	. D TXSTS ^IBCEMU2(I BIFN,,.REJ )
	335	. ;IB2.0 516/TAZ - If CRD is from CSA allow a RE Jected cla im to be C RD'ed with out displa ying a war ning.
	336	. I $G(IB CNCSA),REJ Q
	337	. W *7,!! ?4,$S('$G( IBCNCRD):" Warning! ",1:""),"T his bill i s in a sta tus of REQ UEST MRA."
	338	. W !?4," No MRAs ha ve been re ceived"
	339	. I REJ W ", but th e most rec ent transm ission of this",!?4, "MRA reque st bill wa s rejected ."
	340	. I 'REJ W " and th ere are no rejection messages on file",! ?4,"for th e most rec ent transm ission of this MRA r equest bil l."
	341	. I $G(IB CNCRD) S I BQUIT=1
	342	. Q
	343	;
	344	I IBCAN=2 ,IB("S")]" ",+$P(IB(" S"),U,16), $P(IB("S") ,U,17)]"" D G 1
	345	. W !!,"T his bill w as cancell ed on " S Y=$P(IB("S "),U,17) X ^DD("DD") W Y," by ",$S($P(IB ("S"),U,18 )']"":IBU, $D(^VA(200 ,$P(IB("S" ),U,18),0) ):$P(^(0), U,1),1:IBU ),"."
	346	. S IBQUI T=1
	347	;
	348	; IB2.0 516/TAZ,MR D - Forbid the user from using the optio n CRD
	349	; (Correc t Rejected /Denied Bi ll) on all but prima ry claims.
	350	I $G(IBCN CRD),($$CO B^IBCEF(IB IFN)'="P") D Q
	351	. W !!,"P lease note that COB data may e xist for t his bill."
	352	. W !,"Co py and can cel (CLON) must be u sed to cor rect this bill."
	353	. S IBQUI T=1
	354	. H 3
	355	. Q
	356	;
	357	; Notify if a payme nt has bee n posted t o this bil l before c ancel
	358	N PRCABIL L
	359	S PRCABIL L=$$TPR^PR CAFN(IBIFN )
	360	I PRCABIL L=-1 W !!, "Please no te: PRCA w as unable to determi ne if a pa yment has been poste d." I $G(I BCNCRD)=1 W !,"Copy and cancel (CLON) mu st be used to correc t this bil l." S IBQU IT=1 H 3 Q
	361	I PRCABIL L>0 W !!," Please not e a PAYMEN T of $"_ $$TPR^PRCA FN(IBIFN)_ " has be en POSTED to this bi ll."
	362	; New mes sage for C RD option
	363	I $G(IBCN CRD)=1,PRC ABILL>0 W !,"Copy an d cancel ( CLON) must be used t o correct this bill. " S IBQUIT =1 H 3 Q
	364	;
	365	; If bill was creat ed via Ele ctronic cl aims proce ss then no tify
	366	; user th at cancell ation shou ld occur u sing ECME package
	367	I $$GET1^ DIQ(399,IB IFN_",",46 0)]"" D G :'Y ASK
	368	. W !!!?5 ,"This bil l was crea ted by the "
	369	. W !?5," Electronic Claims Ma nagement E ngine (ECM E)."
	370	. W !?5," Cancellati on needs t o occur in the ECME package by "
	371	. W !?5," submitting a REVERSA L to the P ayer.",!!
	372	. K DIR S DIR("A",1 )="Has a R EVERSAL fo r this e-C laim alrea dy been",D IR("A")="s ubmitted t o the paye r via the ECME packa ge (Y/N)", DIR(0)="Y" ,DIR("B")= "NO" D ^DI R
	373	. I Y=0 W !!,"<PLEA SE SUBMIT A REVERSAL USING THE APPROPRIA TE OPTION IN THE ECM E PACKAGE> ",$C(7)
	374	;
	375	CHK ;
	376	; if user came from CLON, mak e sure the y know abo ut the new CRD optio n IB2.0 447 remove TRICARE m sg.
	377	I $G(IBCN COPY)=1 D
	378	.W !!,*7, "Warning: This opti on should NOT be use d to corre ct Rejecte d/Denied c laims."
	379	.W !," It should ONL Y be used to correct DENIED cl aims which have paym ents"
	380	.W !," pos ted agains t them.*** " ; and cl aims with certain Bi lling Rate Types (Ex ample: TRI CARE)."
	381	;
	382	S (IBCCCC ,IBQUIT)=0 I '$G(IBC EAUTO),'$G (IBMCSCAN) W !!,"ARE YOU SURE YOU WANT T O CANCEL T HIS BILL" S %=2 D YN ^DICN G:%= 0 HELP I % '=1 S IBQU IT=1 G NO
	383	;
	384	I '$G(IBC EAUTO) W ! !,"LAST CH ANCE TO CH ANGE YOUR MIND..."
	385	S DIE=399 ,DA=IBIFN, DIE("NO^") =""
	386	S DR="16; S:'X Y=0;1 9;S IBCCCC =1;"
	387	I $G(IBCE AUTO) S DR ="16////1; 19////EDI/ MRA TURNED OFF;S IBC CCC=1;"
	388	;
	389	; esg - 8 /23/06 - I B2358 - fix semi-c olon in fr ee text fi eld
	390	I $G(IBMC SRSC)'="" S DR="16;S :'X Y=0;19 //^S X=IBM CSRSC;S IB CCCC=1;"
	391	D ^DIE K DIE,DR
	392	;
	393	NO I 'IBCC CC W !!,"< NO ACTION TAKEN>",*7 S IBQUIT= 1 G ASK:IB CAN<2,Q
	394	S IBCCR=$ P($G(^DGCR (399,IBIFN ,"S")),U,1 9)
	395	; update claim # wi th new ite ration IB 2.0447 m ove to lat er in the process
	396	;D:$G(IBC NCRD)=1 CR D
	397	W !!,"... Bill has b een cancel led..." D BULL^IBCBU LL,BSTAT^I BCDC(IBIFN ),PRIOR^IB CCC2(IBIFN )
	398	;
	399	; cancell ing in ing enix claim smanager i f ingenix is running
	400	; clean-u p of varia bles is OK if not co ming in fr om ListMan screen
	401	I $$CM^IB CIUT1(IBIF N) S IBCIS NT=4 D ST2 ^IBCIST I '$G(IBCICN CL) K IBCI SNT,IBCIST AT,IBCIRED T,IBCIERR
	402	;
	403	S IBEDI=$ G(IB364)
	404	I 'IBEDI S IBEDI=+$ $LAST364^I BCEF4(IBIF N)
	405	; ib2.0 547 don't cancel MRA if clonin g a bill t hat is sec ondary to MRA (share the same claim#)
	406	I IBEDI D UPDEDI^IB CEM(IBEDI, "C",,$S($$ MRASEC^IBC EF4(IBIFN) :2,1:"")) ;Update ED I files, i f needed
	407	;
	408	F I="S"," U1" S IB(I )=$S($D(^D GCR(399,IB IFN,I)):^( I),1:"")
	409	S PRCASV( "ARREC")=I BIFN,PRCAS V("AMT")=$ S(IB("U1") ']"":0,1:$ P(IB("U1") ,"^")),PRC ASV("DATE" )=$P(IB("S "),"^",17) ,PRCASV("B Y")=$P(IB( "S"),"^",1 8)
	410	S PRCASV( "COMMENT") =$S($P(IB( "S"),U,19) ]"":$P(IB( "S"),U,19) ,$P(^IBE(3 50.9,1,2), "^",7)]"": $P(^(2),"^ ",7),1:"BI LL CANCELL ED IN MAS" )
	411	S PRCASV( "BY")=$S($ P(IB("S"), U,18)]"":$ P(IB("S"), U,18),1:"" )
	412	; IA#3374 /IB2.043 3 Pass the CRD flag so FMS kno ws to send a cancel record bef ore the ne w E record is sent
	413	;S X=$$CA NCEL^RCBEI B($G(PRCAS V("ARREC") ),$G(PRCAS V("DATE")) ,$G(PRCASV ("BY")),$G (PRCASV("A MT")),$G(P RCASV("COM MENT")))
	414	S PRCASV( "ARCRD")=$ G(IBCNCRD)
	415	S X=$$CAN CEL^RCBEIB ($G(PRCASV ("ARREC")) ,$G(PRCASV ("DATE")), $G(PRCASV( "BY")),$G( PRCASV("AM T")),$G(PR CASV("COMM ENT")),$G( PRCASV("AR CRD")))
	416	W !,$S(X: ">> The re ceivable a ssociated with the c laim was c ancelled." ,1:">> The receivabl e associat ed with th e claim wa s not canc elled.")
	417	I $P(X,U, 2)]"" W !, ">>> ",$P( X,U,2) ; T he reason why the cl aim can no t be cance lled.
	418	I IBCAN<2 D RNB^IBC C1 ;assign a reason not billab le
	419	G ASK:IBC AN<2,Q
	420	;
	421	HELP W !,? 3,"Answer 'YES' or ' Y' if you wish to ca ncel this bill.",!,? 3,"Answer 'NO' or 'N ' if you w ant to abo rt." G CHK
	422	Q
	423	1 I $P(IB( 0),U,13)=1 W !,"This record wa s re-opene d on " S Y =$P(IB(0), U,14) X ^D D("DD") W Y,"." G CH K
	424	G ASK
	425	Q1 K:IBCAN =1 IBQUIT K IBCAN
	426	Q K %,IBEP AR,IBSTAT, IBARST,IBA C1,IB,DFN, IBX,IBZ,DI C,DIE,DR,P RCASV,PRCA SVC,X,Y,IB EDI
	427	;***
	428	;I $D(XRT 0) S:'$D(X RTN) XRTN= "IBCC" D T 1^%ZOSV ;s top rt clo ck
	429	Q
	430	CRD(IBIFN) ; entry t o point to add itera tion # to claim
	431	N IBFDA
	432	S IBITN=$ $ITN^IBCCC (IBIFN)
	433	S IBFDA(3 99,IBIFN_" ,",.01)=IB ITN
	434	D FILE^DI E("","IBFD A")
	435	; this wi ll re-open the claim , so reset to cancel led
	436	S DIE=399 ,DA=IBIFN
	437	S DR="16/ ///1"
	438	D ^DIE K DIE,DR
	439	Q
	440	;
	441	PROCESS(IB IFN,IBCAN) ;
	442	; Entry p oint when the bill n umber is a lready kno wn. Use t his when
	443	; you jus t want to try to can cel this b ill and th is bill on ly.
	444	; Input:
	445	; IBIFN - Interna l bill# (R equired)
	446	; IBCAN - Cancel Flag (opti onal, defa ults to 1 if not inc luded)
	447	;
	448	NEW IBNOA SK
	449	S IBNOASK =1
	450	S IBCAN=$ G(IBCAN,1)
	451	G ASK
	452	;
	453	;IBCC
	454
	455
	456
	457
	458
	459	Routines
	460	Activities
	461	Routine Na me
	462	IBCCC
	463	Enhancemen t Category
	464	New
	465	Modify
	466	Delete
	467	No Change
	468	RTM
	469
	470	Related Op tions
	471	None
	472	Related Ro utines
	473	Routines “ Called By”
	474	Routines “ Called”
	475
	476
	477
	478
	479	Data Dicti onary (DD) Reference s
	480
	481	Related Pr otocols
	482
	483	Related In tegration Control Re gistration s (ICRs)
	484	None
	485	Data Passi ng
	486	Input
	487	Output Re ference
	488	Both
	489	Global Re ference
	490	Local
	491	Input Attr ibute Name and Defin ition
	492	Name:
	493	Definition :
	494	Output Att ribute Nam e and Defi nition
	495	Name:
	496	Definition :
	497	Current Lo gic
	498	IBCCC^INT^ 1^^0
	499	IBCCC ;ALB /AAS - CAN CEL AND CL ONE A BILL ;25-JAN-9 0
	500	;;2.0;INT EGRATED BI LLING;80 ,109,106,5 1,320,433, 432,447,51 6;21-MAR -94;Build 123
	501	;;Per VA Directive 6402, this routine s hould not be modifie d.
	502	;
	503	;MAP TO D GCRCC
	504	;
	505	;STEP 1 - cancel bi ll
	506	;STEP 1.5 - entry t o clone pr eviously c ancelled b ill. (mus t be cance l)
	507	;STEP 2 - build arr ay of IBID S call scr een that a sks ok
	508	;STEP 3 - pass stub entry to ar
	509	;STEP 4 - store stu b data in MCCR then x-ref
	510	;STEP 4.5 - store c laim clone info on " S1" node.
	511	;STEP 5 - get remai nder of da ta to move and store in MCCR t hen x-ref
	512	;STEP 6 - go to scr eens, come out to IB B1
	513	EN ;
	514	N IBBCF,I BBCT,IBBCB ,IBCCR,IBD BC,IBCNCOP Y,IBNOCALC
	515	S IBDBC=D T ;date claim was cloned
	516	S IBBCB=D UZ ;user -id of per son clonin g the clai m.
	517	S IBCNCOP Y=1 ; flag indicatin g this fun ction is e ntered as the copy/c ancel opti on
	518	;
	519	; MRD;IB* 2.0*516 - Added the flag IBNOC ALC. This flag is s et here an d
	520	; below. When char ges are re calculated in BILL^I BCRBC, the first tim e
	521	; that pr ocedure is entered f or the new claim, if the IBNOC ALC flag i s
	522	; set, it will rese t the flag and quit out. That is, it do es not re-
	523	; calcula te the cha rges the f irst time it otherwi se would i f the user
	524	; is doin g either a CRD or CL ON.
	525	;
	526	S IBNOCAL C=1
	527	;
	528	STEP1 I $G (IBCE("EDI "))>1 G EN D1
	529	S IBCAN=2 ,IBQUIT=0, IBAC=6,IBU ="UNSPECIF IED"
	530	I '$G(IBC E("EDI")) D ASK^IBCC
	531	I $G(IBCE ("EDI"))=1 S IB364=" " D NOPTF^ IBCC
	532	G:IBQUIT END1
	533	I 'IBCCCC !('$D(IBIF N)) G STEP 1:'$G(IBCE ("EDI")),E ND1
	534	I $G(IBCE ("EDI")) S IBCE("EDI ")=2
	535	EN1 ;
	536	STEP1P5 I '$D(IBIFN) S IBCAN=2 ,IBQUIT=0, IBAC=6 W ! ,"Copy Pre viously Ca ncelled Bi ll.",!! S DIC="^DGCR (399,",DIC ("S")="I $ P(^(0),U,1 3)=7",DIC( 0)="AEMQZ" ,DIC("A")= "Enter BIL L NUMBER o r Patient NAME: " D ^DIC G:Y<1 END S IBI FN=+Y
	537	;
	538	S IBBCF=I BIFN ;t his is the claim we are copyin g FROM
	539	S IBIDS(. 15)=IBIFN K IBIFN
	540	STEP2 S IB ND0=^DGCR( 399,IBIDS( .15),0) I $D(^("U")) S IBNDU=^ ("U")
	541	; *** Not e - all th ese fields should al so be incl uded in WH ERE^IBCCC1
	542	; IB2.0 432 added check of v ariable IB SILENT to allow COB copy in ba ckground m ode
	543	F I=2:1:1 2 S:$P(IBN D0,"^",I)] "" IBIDS(I /100)=$P(I BND0,"^",I )
	544	F I=16:1: 19,21:1:27 S:$P(IBND 0,"^",I)]" " IBIDS(I/ 100)=$P(IB ND0,"^",I)
	545	F I=151,1 52,155 S I BIDS(I)=$P (IBNDU,"^" ,(I-150))
	546	S IBIDS(1 59.5)=$P(I BNDU,U,20)
	547	; ***
	548	D:$G(IBSI LENT)="" H OME^%ZIS
	549	S DFN=IBI DS(.02) D DEM^VADPT
	550	I +$G(IBC TCOPY)!$G( IBCE("EDI" )) G STEP3
	551	D ^IBCA1
	552	ASK S IBYN =0 W !!,"I S THE ABOV E INFORMAT ION CORREC T AS SHOWN " S %=1 D YN^DICN G END:%=2,ST EP3:%=1 I % G END
	553	W !!?4,"Y ES - If th is informa tion is co rrect as s hown and y ou wish to file the bill.",!?4 ,"NO - If you wish to change this infor mation pri or to fili ng."
	554	W !?4,"'^ ' - Enter the up-arr ow charact er to DELE TE this Bi ll at this time." G ASK
	555	;
	556	STEP3 ;
	557	S PRCASV( "SER")=$P( $G(^IBE(35 0.9,1,1)), "^",14)
	558	S PRCASV( "SITE")=$P ($$SITE^VA SITE,"^",3 ),IBNWBL=" ",PRCASV(" ARCRD")=$G (IBCNCRD)
	559	; IA#386 & 1992 If user came from CRD option, ne ed to pass old bill # and clai m ien, as well as ne w iteratio n number
	560	I $G(IBCN CRD)=1 D C RD^IBCC(IB BCF) S PRC ASV("ARREC ")=IBBCF,P RCASV("ARB IL")=PRCAS V("SITE")_ "-"_$P(IBI TN,"-"),PR CASV("ARIT N")=PRCASV ("SITE")_" -"_IBITN
	561	W:$G(IBSI LENT)="" ! ,"Passing bill to Ac counts Rec eivable Mo dule..." D SETUP^PRC ASVC3 I $S ($P(PRCASV ("ARREC"), "^")=-1:1, $P(PRCASV( "ARBIL")," ^")=-1:1,1 :0) W:$G(I BSILENT)=" " *7," ", $P(PRCASV( "ARREC")," ^",2),$P(P RCASV("ARB IL"),"^",2 ) G END
	562	S IBIDS(. 01)=$P(PRC ASV("ARBIL "),"-",2), IBIDS(.17) =$S($D(IBI DS(.17)):I BIDS(.17), 1:PRCASV(" ARREC"))
	563	I '$G(IBC E("EDI")) W !,"Billi ng Record #",IBIDS(. 01)," bein g establis hed for '" ,VADM(1)," '..." S IB IDS(.02)=D FN,IBHV("I BIFN")=$S( $G(IBIFN): IBIFN,1:$G (IBIDS(.15 )))
	564	G ^IBCCC1 ;go to st ep4
	565	Q
	566	;
	567	END W:$G(I BSILENT)=" " !!,"No B illing Rec ord Set up . You mus t manually enter the bill."
	568	END1 K %,% DT,IBCAN,I BAC,IBND0, IBNDU,IBYN ,IBCCCC,IB IFN,IB,IBA ,IBNWBL,IB BT,IBIDS,I BU,I,J,VA, VADM,X,X1, X2,X3,X4,D ,Y
	569	;I '$G(IB QUIT),$S(+ $G(IBCNCOP Y):1,1:'$G (IBCE("EDI "))) G STE P1
	570	I '$G(IBQ UIT),$S(+$ G(IBCNCOPY )!(+$G(IBC NCRD)):1,1 :'$G(IBCE( "EDI"))) G STEP1
	571	K IBQUIT, IBCNCOPY,I BCNCRD,IBN OCALC
	572	Q
	573	;
	574	ITN(IBX) ; determine iteration # for rej ected or d enied clai m
	575	N IBCF,IB CL
	576	S IBCF=$P ($G(^DGCR( 399,IBX,"S 1")),U,2)
	577	; if this claim has never bee n cloned, iteration # is -01
	578	Q:IBCF="" $P($G(^DG CR(399,IBX ,0)),U)_"- 01"
	579	S IBCL=$P ($G(^DGCR( 399,IBCF,0 )),U)
	580	; if clai m was a CL ON 1st and now a COR RECT, this is the 1s t iteratio n
	581	I $P(IBCL ,"-")'=$P( $P($G(^DGC R(399,IBX, 0)),U),"-" ) Q $P($G( ^DGCR(399, IBX,0)),U) _"-01"
	582	; to dete rmine iter ation#, ne ed to incr iment from claim tha t was clon ed from
	583	S IBITN=$ P(IBCL,"-" ,2),IBITN= IBITN+1 I $L(IBITN)= 1 S IBITN= "0"_IBITN
	584	Q $P(IBCL ,"-")_"-"_ IBITN
	585	;
	586	CRD ; new entry poin t if user comes from CRD optio n instead of CLON
	587	N IBBCF,I BBCT,IBBCB ,IBCCR,IBD BC,IBCNCRD ,IBITN,IBN OCALC
	588	S IBDBC=D T ;date claim was cloned
	589	S IBBCB=D UZ ;user -id of per son clonin g the clai m.
	590	S IBCNCRD =1 ; flag indicating this func tion is en tered as t he CRD opt ion
	591	;
	592	; MRD;IB* 2.0*516 - Added the flag IBNOC ALC. This flag is s et here an d
	593	; above. When char ges are re calculated in BILL^I BCRBC, the first tim e
	594	; that pr ocedure is entered f or the new claim, if the IBNOC ALC flag i s
	595	; set, it will rese t the flag and quit out. That is, it do es not re-
	596	; calcula te the cha rges the f irst time it otherwi se would i f the user
	597	; is doin g either a CRD or CL ON.
	598	;
	599	S IBNOCAL C=1
	600	;
	601	G STEP1
	602	Q
	603	;
	604	Modified L ogic (Chan ges are in bold)
	605	IBCCC ;ALB /AAS - CAN CEL AND CL ONE A BILL ;25-JAN-9 0
	606	;;2.0;INT EGRATED BI LLING;80 ,109,106,5 1,320,433, 432,447,51 6;21-MAR -94;Build 123
	607	;;Per VA Directive 6402, this routine s hould not be modifie d.
	608	;
	609	;MAP TO D GCRCC
	610	;
	611	;STEP 1 - cancel bi ll
	612	;STEP 1.5 - entry t o clone pr eviously c ancelled b ill. (mus t be cance l)
	613	;STEP 2 - build arr ay of IBID S call scr een that a sks ok
	614	;STEP 3 - pass stub entry to ar
	615	;STEP 4 - store stu b data in MCCR then x-ref
	616	;STEP 4.5 - store c laim clone info on " S1" node.
	617	;STEP 5 - get remai nder of da ta to move and store in MCCR t hen x-ref
	618	;STEP 6 - go to scr eens, come out to IB B1
	619	EN ;
	620	N IBBCF,I BBCT,IBBCB ,IBCCR,IBD BC,IBCNCOP Y,IBNOCALC
	621	S IBDBC=D T ;date claim was cloned
	622	S IBBCB=D UZ ;user -id of per son clonin g the clai m.
	623	S IBCNCOP Y=1 ; flag indicatin g this fun ction is e ntered as the copy/c ancel opti on
	624	;
	625	; MRD;IB* 2.0*516 - Added the flag IBNOC ALC. This flag is s et here an d
	626	; below. When char ges are re calculated in BILL^I BCRBC, the first tim e
	627	; that pr ocedure is entered f or the new claim, if the IBNOC ALC flag i s
	628	; set, it will rese t the flag and quit out. That is, it do es not re-
	629	; calcula te the cha rges the f irst time it otherwi se would i f the user
	630	; is doin g either a CRD or CL ON.
	631	;
	632	S IBNOCAL C=1
	633	;
	634	STEP1 I $G (IBCE("EDI "))>1 G EN D1
	635	S IBCAN=2 ,IBQUIT=0, IBAC=6,IBU ="UNSPECIF IED"
	636	I '$G(IBC E("EDI")) D ASK^IBCC
	637	I $G(IBCE ("EDI"))=1 S IB364=" " D NOPTF^ IBCC
	638	G:IBQUIT END1
	639	;JRA use $G to prev ent <UNDEF > error wh en/if IBCC CC=""
	640	;I 'IBCCC C!('$D(IBI FN)) G STE P1:'$G(IBC E("EDI")), END1 ;JRA ';'
	641	I '$G(IBC CCC)!('$D( IBIFN)) G STEP1:'$G( IBCE("EDI" )),END1 ; JRA add $G for IBCCC C
	642	I $G(IBCE ("EDI")) S IBCE("EDI ")=2
	643	EN1 ;
	644	STEP1P5 I '$D(IBIFN) S IBCAN=2 ,IBQUIT=0, IBAC=6 W ! ,"Copy Pre viously Ca ncelled Bi ll.",!! S DIC="^DGCR (399,",DIC ("S")="I $ P(^(0),U,1 3)=7",DIC( 0)="AEMQZ" ,DIC("A")= "Enter BIL L NUMBER o r Patient NAME: " D ^DIC G:Y<1 END S IBI FN=+Y
	645	;
	646	S IBBCF=I BIFN ;t his is the claim we are copyin g FROM
	647	S IBIDS(. 15)=IBIFN K IBIFN
	648	STEP2 S IB ND0=^DGCR( 399,IBIDS( .15),0) I $D(^("U")) S IBNDU=^ ("U")
	649	; *** Not e - all th ese fields should al so be incl uded in WH ERE^IBCCC1
	650	; IB2.0 432 added check of v ariable IB SILENT to allow COB copy in ba ckground m ode
	651	F I=2:1:1 2 S:$P(IBN D0,"^",I)] "" IBIDS(I /100)=$P(I BND0,"^",I )
	652	F I=16:1: 19,21:1:27 S:$P(IBND 0,"^",I)]" " IBIDS(I/ 100)=$P(IB ND0,"^",I)
	653	F I=151,1 52,155 S I BIDS(I)=$P (IBNDU,"^" ,(I-150))
	654	S IBIDS(1 59.5)=$P(I BNDU,U,20)
	655	; ***
	656	D:$G(IBSI LENT)="" H OME^%ZIS
	657	S DFN=IBI DS(.02) D DEM^VADPT
	658	I +$G(IBC TCOPY)!$G( IBCE("EDI" )) G STEP3
	659	D ^IBCA1
	660	ASK S IBYN =0 W !!,"I S THE ABOV E INFORMAT ION CORREC T AS SHOWN " S %=1 D YN^DICN G END:%=2,ST EP3:%=1 I % G END
	661	W !!?4,"Y ES - If th is informa tion is co rrect as s hown and y ou wish to file the bill.",!?4 ,"NO - If you wish to change this infor mation pri or to fili ng."
	662	W !?4,"'^ ' - Enter the up-arr ow charact er to DELE TE this Bi ll at this time." G ASK
	663	;
	664	STEP3 ;
	665	S PRCASV( "SER")=$P( $G(^IBE(35 0.9,1,1)), "^",14)
	666	S PRCASV( "SITE")=$P ($$SITE^VA SITE,"^",3 ),IBNWBL=" ",PRCASV(" ARCRD")=$G (IBCNCRD)
	667	; IA#386 & 1992 If user came from CRD option, ne ed to pass old bill # and clai m ien, as well as ne w iteratio n number
	668	I $G(IBCN CRD)=1 D C RD^IBCC(IB BCF) S PRC ASV("ARREC ")=IBBCF,P RCASV("ARB IL")=PRCAS V("SITE")_ "-"_$P(IBI TN,"-"),PR CASV("ARIT N")=PRCASV ("SITE")_" -"_IBITN
	669	W:$G(IBSI LENT)="" ! ,"Passing bill to Ac counts Rec eivable Mo dule..." D SETUP^PRC ASVC3 I $S ($P(PRCASV ("ARREC"), "^")=-1:1, $P(PRCASV( "ARBIL")," ^")=-1:1,1 :0) W:$G(I BSILENT)=" " *7," ", $P(PRCASV( "ARREC")," ^",2),$P(P RCASV("ARB IL"),"^",2 ) G END
	670	S IBIDS(. 01)=$P(PRC ASV("ARBIL "),"-",2), IBIDS(.17) =$S($D(IBI DS(.17)):I BIDS(.17), 1:PRCASV(" ARREC"))
	671	I '$G(IBC E("EDI")) W !,"Billi ng Record #",IBIDS(. 01)," bein g establis hed for '" ,VADM(1)," '..." S IB IDS(.02)=D FN,IBHV("I BIFN")=$S( $G(IBIFN): IBIFN,1:$G (IBIDS(.15 )))
	672	G ^IBCCC1 ;go to st ep4
	673	Q
	674	;
	675	END W:$G(I BSILENT)=" " !!,"No B illing Rec ord Set up . You mus t manually enter the bill."
	676	END1 K %,% DT,IBCAN,I BAC,IBND0, IBNDU,IBYN ,IBIFN,IB, IBA,IBNWBL ,IBBT,IBID S,IBU,I,J, VA,VADM,X, X1,X2,X3,X 4,D,Y ;JR A remove I BCCCC from KILL
	677	;I '$G(IB QUIT),$S(+ $G(IBCNCOP Y):1,1:'$G (IBCE("EDI "))) G STE P1
	678	I '$G(IBQ UIT),$S(+$ G(IBCNCOPY )!(+$G(IBC NCRD)):1,1 :'$G(IBCE( "EDI"))) G STEP1
	679	K IBQUIT, IBCNCOPY,I BCNCRD,IBN OCALC,IBCC CC ;JRA A dded IBCCC C to KILL
	680	Q
	681	;
	682	ITN(IBX) ; determine iteration # for rej ected or d enied clai m
	683	N IBCF,IB CL
	684	S IBCF=$P ($G(^DGCR( 399,IBX,"S 1")),U,2)
	685	; if this claim has never bee n cloned, iteration # is -01
	686	Q:IBCF="" $P($G(^DG CR(399,IBX ,0)),U)_"- 01"
	687	S IBCL=$P ($G(^DGCR( 399,IBCF,0 )),U)
	688	; if clai m was a CL ON 1st and now a COR RECT, this is the 1s t iteratio n
	689	I $P(IBCL ,"-")'=$P( $P($G(^DGC R(399,IBX, 0)),U),"-" ) Q $P($G( ^DGCR(399, IBX,0)),U) _"-01"
	690	; to dete rmine iter ation#, ne ed to incr iment from claim tha t was clon ed from
	691	S IBITN=$ P(IBCL,"-" ,2),IBITN= IBITN+1 I $L(IBITN)= 1 S IBITN= "0"_IBITN
	692	Q $P(IBCL ,"-")_"-"_ IBITN
	693	;
	694	CRD ; new entry poin t if user comes from CRD optio n instead of CLON
	695	N IBBCF,I BBCT,IBBCB ,IBCCR,IBD BC,IBCNCRD ,IBITN,IBN OCALC
	696	S IBDBC=D T ;date claim was cloned
	697	S IBBCB=D UZ ;user -id of per son clonin g the clai m.
	698	S IBCNCRD =1 ; flag indicating this func tion is en tered as t he CRD opt ion
	699	;
	700	; MRD;IB* 2.0*516 - Added the flag IBNOC ALC. This flag is s et here an d
	701	; above. When char ges are re calculated in BILL^I BCRBC, the first tim e
	702	; that pr ocedure is entered f or the new claim, if the IBNOC ALC flag i s
	703	; set, it will rese t the flag and quit out. That is, it do es not re-
	704	; calcula te the cha rges the f irst time it otherwi se would i f the user
	705	; is doin g either a CRD or CL ON.
	706	;
	707	S IBNOCAL C=1
	708	;
	709	G STEP1
	710	Q
	711	;
	712
	713
	714	Routines
	715	Activities
	716	Routine Na me
	717	IBCCCB
	718	Enhancemen t Category
	719	New
	720	Modify
	721	Delete
	722	No Change
	723	RTM
	724
	725	Related Op tions
	726	None
	727	Related Ro utines
	728	Routines “ Called By”
	729	Routines “ Called”
	730
	731
	732
	733
	734	Data Dicti onary (DD) Reference s
	735
	736	Related Pr otocols
	737
	738	Related In tegration Control Re gistration s (ICRs)
	739	None
	740	Data Passi ng
	741	Input
	742	Output Re ference
	743	Both
	744	Global Re ference
	745	Local
	746	Input Attr ibute Name and Defin ition
	747	Name:
	748	Definition :
	749	Output Att ribute Nam e and Defi nition
	750	Name:
	751	Definition :
	752	Current Lo gic
	753	IBCCCB^INT ^1^^0
	754	IBCCCB ;AL B/ARH - CO PY BILL FO R COB ;2/1 3/06 10:46 am
	755	;;2.0;INT EGRATED BI LLING;80 ,106,51,15 1,137,182, 155,323,43 6,432,447, 547;21-M AR-94;Buil d 119
	756	;;Per VA Directive 6402, this routine s hould not be modifie d.
	757	;
	758	; Copy bi ll for COB w/out can celling, u pdate some flds
	759	; Primary ->Secondar y->Tertiar y
	760	ASK ;
	761	S IBCBCOP Y=1 ; flag that copy function entered th ru Copy CO B option
	762	;
	763	D KVAR S IBCAN=2,IB U="UNSPECI FIED"
	764	;
	765	S IBX=$$P B^IBJTU2 S :+IBX=2 IB IFN=$P(IBX ,U,2) I +I BX=1 S DFN =$P(IBX,U, 2),IBV=1,I BAC=5 D DA TE^IBCB
	766	I '$G(IBI FN) G EXIT
	767	;
	768	; IB2.0 432 Restri ct access to only al low claims that are NOT on the new CBW W orklist
	769	I $P($G(^ DGCR(399,I BIFN,"S1") ),U,7)=1,$ G(IBMRANOT )'=1 D G ASK
	770	. W !!?4, "This bill appears o n the CBW Management Work List . Please use the"
	771	. W !?4," 'CBW Manag ement Menu ' options for all pr ocessing r elated to this bill. "
	772	. Q
	773	; Restric t access t o this pro cess for R EQUEST MRA bills in 2 Cases:
	774	; 1. No M RA EOB's o n File for bill
	775	I $P($G(^ DGCR(399,I BIFN,0)),U ,13)=2,'$$ CHK^IBCEMU 1(IBIFN) D G ASK
	776	. W !!?4, "This bill is in a s tatus of R EQUEST MRA and it ha s No MRA E OB's"
	777	. W !?4," on file. Access to this bill is restric ted."
	778	;
	779	; 2. At l east one M RA EOB app ears on th e MRA mana gement wor klist
	780	I $P($G(^ DGCR(399,I BIFN,0)),U ,13)=2,$$M RAWL^IBCEM U2(IBIFN) D G ASK
	781	. W !!?4, "This bill is in a s tatus of R EQUEST MRA and it do es appear on the"
	782	. W !?4," MRA Manage ment Work List. Ple ase use th e 'MRA Man agement Me nu' option s"
	783	. W !?4," for all pr ocessing r elated to this bill. "
	784	. Q
	785	;
	786	; If MRA is Activat ed and bil l is in En tered/Not Reviewed s tatus and current in surance Co . is WNR - ->
	787	; ask if user wants to contin ue
	788	I $$EDIAC TV^IBCEF4( 2),$P($G(^ DGCR(399,I BIFN,0)),U ,13)=1,$$M CRWNR^IBEF UNC(+$$CUR R^IBCEF2(I BIFN)) D I 'Y G ASK
	789	. W !!?4, "This bill is in a s tatus of E NTERED/NOT REVIEWED and curren t payer is "
	790	. W !?4," MEDICARE ( WNR). No M RA has bee n requeste d for this bill."
	791	. S DIR(0 )="YA",DIR ("B")="NO" ,DIR("A")= " Are y ou sure yo u want to continue t o process this bill? : "
	792	. D ^DIR K DIR
	793	;
	794	; Display related b ills
	795	D DSPRB^I BCCCB0(IBI FN)
	796	;
	797	CHKB ; Ent rypoint-CO B processi ng via EDI 's COB Mgm t
	798	; Ask if final EOB was receiv ed for pre vious bill
	799	I '$$FINA LEOB^IBCCC B0(IBIFN) S IBSECHK= 1
	800	I $G(IBSE CHK)=1,$$M CRONBIL^IB EFUNC(IBIF N) G EXIT
	801	;
	802	; Warn if previous bill not a t least au thorized
	803	I '$$MCRO NBIL^IBEFU NC(IBIFN) I '$$COBOK ^IBCCCB0(I BIFN) G EX IT
	804	;
	805	CHKB1 ; En try point for Automa tic/Silent COB Proce ssing.
	806	; No writ es or read s can occu r from thi s point fo rward if v ariable
	807	; IBSILEN T=1. Any and all er ror messag es should be process ed with
	808	; the ERR OR procedu re below.
	809	;
	810	S IBX=$G( ^DGCR(399, +IBIFN,0)) ,DFN=$P(IB X,U,2),IBD T=$P(IBX,U ,3)\1,IBER =""
	811	I IBCAN>1 D NOPTF^I BCB2 I 'IB AC1 D NOPT F1^IBCB2 G ASK1
	812	;
	813	F IBI=0," S","U1","M ","MP","M1 " S IB(IBI )=$G(^DGCR (399,IBIFN ,IBI))
	814	I IB(0)=" " S IBER=" Invalid Bi ll Number" D ERROR G ASK1
	815	;
	816	; check t o see if t he bill ha s been can celled
	817	I $P(IB(" S"),U,16), $P(IB("S") ,U,17) D G ASK1
	818	. N WHO
	819	. S IBER= "This bill was cance lled on "
	820	. S IBER= IBER_$$FMT E^XLFDT($P (IB("S"),U ,17),"1Z") _" by "
	821	. S WHO=" UNSPECIFIE D"
	822	. I $P(IB ("S"),U,18 ) S WHO=$P ($G(^VA(20 0,$P(IB("S "),U,18),0 )),U,1)
	823	. S IBER= IBER_WHO_" ."
	824	. D ERROR
	825	. Q
	826	;
	827	S IBCOB=$ $COB^IBCEF (IBIFN),IB COBN=$TR(I BCOB,"PSTA ","12")
	828	S IBMRAIO =+$$CURR^I BCEF2(IBIF N),IBMRAO= $$MCRWNR^I BEFUNC(IBM RAIO)
	829	S IBNMOLD =$S(IBCOB= "P":"Prima ry",IBCOB= "S":"Secon dary",IBCO B="T":"Ter tiary",IBC OB="A":"Pa tient",1:" ")_$S(IBMR AO:"-MRA O nly",1:"")
	830	S IBINSOL D=$G(^DIC( 36,$S(IB(" MP"):+IB(" MP"),IBMRA O:IBMRAIO, 1:0),0))
	831	;
	832	NEXTP ; If current b ill=MEDICA RE WNR and valid 'ne xt payer', use same
	833	; bill f or new pay er
	834	; If next valid 'pa yer' is in s co or ME DICARE WNR , create n ew bill
	835	S IBCOBN= IBCOBN+1,I BNM=$S(IBC OBN=2:"Sec ondary Pay er",IBCOBN =3:"Tertia ry Payer", 1:"")
	836	;
	837	I IBNM="" S IBER=$P (IB(0),U,1 )_" is a " _IBNMOLD_" bill, the re is no n ext bill i n the seri es." D ERR OR G ASK1
	838	;
	839	S IBX=+$P (IB("M1"), U,(4+IBCOB N)),IBY=$G (^DGCR(399 ,+IBX,0)), IBCOBIL(+I BIFN)=""
	840	;
	841	I $P(IBY, U,13)=7 S IBER="The "_$P(IBNM, " ",1)_" b ill "_$P(I BY,U,1)_" has been c ancelled." D ERROR S IBX=""
	842	;
	843	I +IBX,$D (IBCOBIL(+ IBX)) S IB ER="Next b ill in ser ies can no t be deter mined." D ERROR G AS K1
	844	I +IBX S IBER=$P(IB NM," ",1)_ " bill alr eady defin ed for thi s series: "_$P(IBY,U ,1) D ERRO R S IBIFN= IBX G ASK1
	845	;
	846	S IBINSN= $P(IB("M") ,U,IBCOBN) I 'IBINSN S IBER="T here is no "_IBNM_" for "_$P(I B(0),U,1)_ "." D ERRO R G ASK1
	847	S IBINS=$ G(^DIC(36, +IBINSN,0) ) I IBINS= "" S IBER= "The "_IBN M_" for "_ $P(IB(0),U ,1)_" is n ot a valid Insurance Co." D ER ROR G ASK1
	848	;
	849	S IBMRA=0
	850	I $P(IBIN S,U,2)="N" S IBQ=0 D G:IBQ NE XTP
	851	. I $$MCR WNR^IBEFUN C(IBINSN) D Q
	852	.. ; Chec k if a val id tert in s if MCR W NR seconda ry
	853	.. I IBCO BN'>2 D
	854	... N Z
	855	... S Z=+ $P(IB("M") ,U,IBCOBN+ 1)
	856	... I Z,$ D(^DIC(36, Z,0)),$P(^ (0),U,2)'= "N" S IBMR A=1,IBNM=$ P(IBNM," " )_"-MRA.On ly"
	857	.. I 'IBM RA S IBER= "MEDICARE will not r eimburse a nd no furt her valid insurance for bill" D ERROR S IBQ=1
	858	. S IBER= $P(IB(0),U ,1)_" "_IB NM_", "_$P (IBINS,U,1 )_", will not Reimbu rse" D ERR OR S IBQ=1
	859	;
	860	; If proc essing in silent mod e, skip ov er the fol lowing rea ds
	861	I $G(IBSI LENT) G SK IP
	862	;
	863	W !!
	864	S DIR("?" )="Enter Y es to "_$S ('$G(IBMRA O):"create a new bil l in the b ill series for this care. The new bill will be th e "_$P(IBN M," ")_" b ill ",1:"e nter the M RA informa tion and c hange the payer to t he "_$P($P (IBNM,"-") ," ")_" pa yer ")
	865	S DIR("?" )=DIR("?") _$S('IBMRA :"with the "_IBNM_" responsibl e for paym ent.",1:"a nd will re quest an M RA from ME DICARE.")
	866	S DIR(0)= "YO",DIR(" A")=$S('$G (IBMRAO):" Copy "_$P( IB(0),U,1) _" for a b ill to the ",1:"Chan ge payer o n bill "_$ P(IB(0),U, 1)_" to ") _IBNM_", " _$P(IBINS, U,1) D ^DI R K DIR I Y'=1 S IBS ECHK=1 G A SK1
	867	;
	868	W !
	869	S IBQ=0
	870	I '$G(IBM RAO) D G: IBQ ASK1
	871	. N Z
	872	. S DIR(" ?")="Enter the amoun t of the p ayment fro m the paye r of the " _IBNMOLD_" bill."
	873	. S DIR(" ?")=DIR("? ")_" This will be a dded to th e new bill as a prio r payment and subtra cted from the charge s due for the new bi ll."
	874	. S DIR(" A")="Prior Payment f rom "_$P(I B(0),U,1)_ " "_IBNMOL D_" Payer, "_$P(IBIN SOLD,U,1)_ ": "
	875	. S Z=$$E OBTOT^IBCE U1(IBIFN,$ $COBN^IBCE F(IBIFN))
	876	. S:Z DIR ("B")=Z
	877	. S DIR(0 )="NOA^0:9 9999999:2"
	878	. D ^DIR K DIR I Y= ""!$D(DIRU T) S IBQ=1
	879	. K IBCOB
	880	. S IBCOB ("U2",IBCO BN+2)=Y
	881	. Q
	882	;
	883	SKIP ; Jum p here if skipping o ver the pr eceeding r eads
	884	;
	885	; If paye r is Medic are (WNR) update pay er sequenc e and quit
	886	I IBMRAO! ($G(IBSTSM )=1) D I $G(IBSTSM) '=1 G END
	887	. N IBPRT OT,IBTOTCH G,IBPTRESP
	888	. S IBTOT CHG=0
	889	. ;
	890	. ; Get T otal Charg es from BI LLS/CLAIMS (#399) fi le
	891	. S IBTOT CHG=$P($G( ^DGCR(399, IBIFN,"U1" )),U,1)
	892	. ; Calcu late Patie nt Respons ibility fo r Bill
	893	. ; IB2. 0447 If c laim's typ e of plan has effect ive date m ultiple, u se those c alculation s
	894	. ;S IBPT RESP=$$PRE OBTOT^IBCE U0(IBIFN,$ G(IBSTSM))
	895	. ; Calcu late Patie nt Primary /Secondary Prior Pay ment (fiel d 218 or 2 19 of File 399)
	896	. ; These fields ar e stored i n DGCR(399 ,IBIFN,"U2 ") pieces 4 and 5 re spectively
	897	. ; Calcu late: Prio r Payment= Total Sub mitted Cha rges - Pat ient Respo nsibility
	898	. S:$G(IB STSM)'=1 I BPTRESP=$S ($$MSEDT^I BCEMU4(IBI FN)'="":$$ MSPRE^IBCE MU4(IBIFN) ,1:$$PREOB TOT^IBCEU0 (IBIFN,$G( IBSTSM))), IBPRTOT=IB TOTCHG-IBP TRESP
	899	. S:$G(IB STSM)=1 IB PRTOT=$$EO BTOT^IBCEU 1(IBIFN,$$ COBN^IBCEF (IBIFN)) ; Pat Resp f or non-med icare
	900	. I IBPRT OT<0 S IBP RTOT=0 ; don't allow nega tive prior payment o r offset
	901	. S IBCOB ("U2",IBCO BN+2)=IBPR TOT
	902	. ; IB2. 0547 don' t change s tatus back to 1.5 if auto-crea ting secon dary or te rtiary in silent mod e
	903	. ; D:$G( IBSTSM)'=1 COBCHG^IB CCC2(IBIFN ,IBMRAIO,. IBCOB)
	904	. ; D STA T^IBCEMU2( IBIFN,1.5, 1) ; m ra eob sta tus update
	905	. I $G(IB STSM)'=1 D COBCHG^IB CCC2(IBIFN ,IBMRAIO,. IBCOB),STA T^IBCEMU2( IBIFN,1.5, 1) ; m ra eob sta tus update
	906	. I $G(IB SILENT) S IBERRMSG=" "
	907	. Q
	908	;
	909	; We shou ld NOT get to here i n silent m ode .... j ust in cas e
	910	I $G(IBSI LENT),$G(I BSTSM)'=1 G END ; currently only MCRW NR in sile nt mode
	911	;
	912	; Payer i s not Medi care (WNR) - Perform additiona l steps
	913	S IBCOB(0 ,15)=""
	914	S IBCOB(0 ,21)=$S(IB COBN=2:"S" ,IBCOBN=3: "T",1:"")
	915	I IBCOB(0 ,21)="" G END
	916	S IBCOB(" M1",IBCOBN +3)=IBIFN
	917	S IBIDS(. 15)=IBIFN
	918	D KVAR
	919	G STEP2^I BCCC
	920	;
	921	END ;
	922	Q
	923	;
	924	;
	925	ASK1 ; If entering t hru EDI CO B processi ng, don't ask for ne w bill, qu it
	926	I $G(IBCB ASK) G EXI T
	927	G ASK
	928	;
	929	ERROR ; Di splay/Save error mes sage
	930	I '$G(IBS ILENT) W ! ,IBER,!
	931	E S IBER RMSG=IBER
	932	S IBER=""
	933	I $D(IBSE CHK) S IBS ECHK=1
	934	Q
	935	;
	936	EXIT K IBC AN,IBCOB,I BU
	937	KVAR K IBX ,IBY,IBI,I BIFN,DFN,I BDT,IB,IBC OBN,IBNMOL D,IBINSOLD ,IBNM,IBIN SN,IBINS,I BER,DIR,IB AC,IBAC1,I BV,X,Y,IBD ATA,IBT,IB ND0,DIRUT, IBCOBIL,IB MRA,IBMRAI ,IBMRAO,IB MRAIO,IBCB COPY
	938	K ^UTILIT Y($J)
	939	Q
	940	;
	941	DSPRB(IBIF N) ; displ ay related bills
	942	;
	943	D DSPRB^I BCCCB0(IBI FN) ; Code moved for size too big
	944	Q
	945	;
	946	; ======= =======
	947	;
	948	; Copy a bill for R easonable Charges wi thout canc elling it, update ce rtain fiel ds
	949	;
	950	; there i s always b oth inpt i nst (creat ed first) and prof c harges, al ways need both bills
	951	; there m ay be both outpt ins t (created first) an d prof cha rges, may not need b oth bills
	952	; if bill ing by epi sode rathe r than by day (curre nt standar d) then ma y need mul tiple prof bills per day
	953	;
	954	; Inst bi lls are co pied to cr eate prof Bills auto matically
	955	; Subsequ ent prof b ills may b e created if the use r wants th em
	956	;
	957	; Only th e first bi ll in the COB series of bills should be copied for the next prof bill
	958	; The pri mary inst bill shoul d be copie d to get t he seconda ry inst bi ll
	959	; The pri mary prof bill shoul d be copie d to get t he seconda ry prof bi ll
	960	;
	961	CTCOPY(IBI FN,IBMRA) ; based on the type of bill, c opy withou t cancelli ng
	962	; IBMRA = 1 if an M RA bill an d copy for prof comp onents is desired
	963	;
	964	D CTCOPY^ IBCCCB0(IB IFN,$G(IBM RA)) ;Move d due to r outine siz e
	965	Q
	966	;
	967	Modified L ogic (Chan ges are in bold)
	968	IBCCCB ;AL B/ARH - CO PY BILL FO R COB ;2/1 3/06 10:46 am
	969	;;2.0;INT EGRATED BI LLING;80 ,106,51,15 1,137,182, 155,323,43 6,432,447, 547;21-M AR-94;Buil d 119
	970	;;Per VA Directive 6402, this routine s hould not be modifie d.
	971	;
	972	; Copy bi ll for COB w/out can celling, u pdate some flds
	973	; Primary ->Secondar y->Tertiar y
	974	ASK ;
	975	S IBCBCOP Y=1 ; flag that copy function entered th ru Copy CO B option
	976	;
	977	D KVAR S IBCAN=2,IB U="UNSPECI FIED"
	978	;
	979	S IBX=$$P B^IBJTU2 S :+IBX=2 IB IFN=$P(IBX ,U,2) I +I BX=1 S DFN =$P(IBX,U, 2),IBV=1,I BAC=5 D DA TE^IBCB
	980	I '$G(IBI FN) G EXIT
	981	;
	982	; IB2.0 432 Restri ct access to only al low claims that are NOT on the new CBW W orklist
	983	I $P($G(^ DGCR(399,I BIFN,"S1") ),U,7)=1,$ G(IBMRANOT )'=1 D G ASK
	984	. W !!?4, "This bill appears o n the CBW Management Work List . Please use the"
	985	. W !?4," 'CBW Manag ement Menu ' options for all pr ocessing r elated to this bill. "
	986	. S IBQUI T=1 ;JRA need to se t quit fla g after is suing this message
	987	. Q
	988	; Restric t access t o this pro cess for R EQUEST MRA bills in 2 Cases:
	989	; 1. No M RA EOB's o n File for bill
	990	I $P($G(^ DGCR(399,I BIFN,0)),U ,13)=2,'$$ CHK^IBCEMU 1(IBIFN) D G ASK
	991	. W !!?4, "This bill is in a s tatus of R EQUEST MRA and it ha s No MRA E OB's"
	992	. W !?4," on file. Access to this bill is restric ted."
	993	;
	994	; 2. At l east one M RA EOB app ears on th e MRA mana gement wor klist
	995	I $P($G(^ DGCR(399,I BIFN,0)),U ,13)=2,$$M RAWL^IBCEM U2(IBIFN) D G ASK
	996	. W !!?4, "This bill is in a s tatus of R EQUEST MRA and it do es appear on the"
	997	. W !?4," MRA Manage ment Work List. Ple ase use th e 'MRA Man agement Me nu' option s"
	998	. W !?4," for all pr ocessing r elated to this bill. "
	999	. Q
	1000	;
	1001	; If MRA is Activat ed and bil l is in En tered/Not Reviewed s tatus and current in surance Co . is WNR - ->
	1002	; ask if user wants to contin ue
	1003	I $$EDIAC TV^IBCEF4( 2),$P($G(^ DGCR(399,I BIFN,0)),U ,13)=1,$$M CRWNR^IBEF UNC(+$$CUR R^IBCEF2(I BIFN)) D I 'Y G ASK
	1004	. W !!?4, "This bill is in a s tatus of E NTERED/NOT REVIEWED and curren t payer is "
	1005	. W !?4," MEDICARE ( WNR). No M RA has bee n requeste d for this bill."
	1006	. S DIR(0 )="YA",DIR ("B")="NO" ,DIR("A")= " Are y ou sure yo u want to continue t o process this bill? : "
	1007	. D ^DIR K DIR
	1008	;
	1009	; Display related b ills
	1010	D DSPRB^I BCCCB0(IBI FN)
	1011	;
	1012	CHKB ; Ent rypoint-CO B processi ng via EDI 's COB Mgm t
	1013	; Ask if final EOB was receiv ed for pre vious bill
	1014	I '$$FINA LEOB^IBCCC B0(IBIFN) S IBSECHK= 1
	1015	I $G(IBSE CHK)=1,$$M CRONBIL^IB EFUNC(IBIF N) G EXIT
	1016	;
	1017	; Warn if previous bill not a t least au thorized
	1018	I '$$MCRO NBIL^IBEFU NC(IBIFN) I '$$COBOK ^IBCCCB0(I BIFN) G EX IT
	1019	;
	1020	CHKB1 ; En try point for Automa tic/Silent COB Proce ssing.
	1021	; No writ es or read s can occu r from thi s point fo rward if v ariable
	1022	; IBSILEN T=1. Any and all er ror messag es should be process ed with
	1023	; the ERR OR procedu re below.
	1024	;
	1025	S IBX=$G( ^DGCR(399, +IBIFN,0)) ,DFN=$P(IB X,U,2),IBD T=$P(IBX,U ,3)\1,IBER =""
	1026	I IBCAN>1 D NOPTF^I BCB2 I 'IB AC1 D NOPT F1^IBCB2 G ASK1
	1027	;
	1028	F IBI=0," S","U1","M ","MP","M1 " S IB(IBI )=$G(^DGCR (399,IBIFN ,IBI))
	1029	I IB(0)=" " S IBER=" Invalid Bi ll Number" D ERROR G ASK1
	1030	;
	1031	; check t o see if t he bill ha s been can celled
	1032	I $P(IB(" S"),U,16), $P(IB("S") ,U,17) D G ASK1
	1033	. N WHO
	1034	. S IBER= "This bill was cance lled on "
	1035	. S IBER= IBER_$$FMT E^XLFDT($P (IB("S"),U ,17),"1Z") _" by "
	1036	. S WHO=" UNSPECIFIE D"
	1037	. I $P(IB ("S"),U,18 ) S WHO=$P ($G(^VA(20 0,$P(IB("S "),U,18),0 )),U,1)
	1038	. S IBER= IBER_WHO_" ."
	1039	. D ERROR
	1040	. Q
	1041	;
	1042	S IBCOB=$ $COB^IBCEF (IBIFN),IB COBN=$TR(I BCOB,"PSTA ","12")
	1043	S IBMRAIO =+$$CURR^I BCEF2(IBIF N),IBMRAO= $$MCRWNR^I BEFUNC(IBM RAIO)
	1044	S IBNMOLD =$S(IBCOB= "P":"Prima ry",IBCOB= "S":"Secon dary",IBCO B="T":"Ter tiary",IBC OB="A":"Pa tient",1:" ")_$S(IBMR AO:"-MRA O nly",1:"")
	1045	S IBINSOL D=$G(^DIC( 36,$S(IB(" MP"):+IB(" MP"),IBMRA O:IBMRAIO, 1:0),0))
	1046	;
	1047	NEXTP ; If current b ill=MEDICA RE WNR and valid 'ne xt payer', use same
	1048	; bill f or new pay er
	1049	; If next valid 'pa yer' is in s co or ME DICARE WNR , create n ew bill
	1050	S IBCOBN= IBCOBN+1,I BNM=$S(IBC OBN=2:"Sec ondary Pay er",IBCOBN =3:"Tertia ry Payer", 1:"")
	1051	;
	1052	I IBNM="" S IBER=$P (IB(0),U,1 )_" is a " _IBNMOLD_" bill, the re is no n ext bill i n the seri es." D ERR OR G ASK1
	1053	;
	1054	S IBX=+$P (IB("M1"), U,(4+IBCOB N)),IBY=$G (^DGCR(399 ,+IBX,0)), IBCOBIL(+I BIFN)=""
	1055	;
	1056	I $P(IBY, U,13)=7 S IBER="The "_$P(IBNM, " ",1)_" b ill "_$P(I BY,U,1)_" has been c ancelled." D ERROR S IBX=""
	1057	;
	1058	I +IBX,$D (IBCOBIL(+ IBX)) S IB ER="Next b ill in ser ies can no t be deter mined." D ERROR G AS K1
	1059	I +IBX S IBER=$P(IB NM," ",1)_ " bill alr eady defin ed for thi s series: "_$P(IBY,U ,1) D ERRO R S IBIFN= IBX G ASK1
	1060	;
	1061	S IBINSN= $P(IB("M") ,U,IBCOBN) I 'IBINSN S IBER="T here is no "_IBNM_" for "_$P(I B(0),U,1)_ "." D ERRO R G ASK1
	1062	S IBINS=$ G(^DIC(36, +IBINSN,0) ) I IBINS= "" S IBER= "The "_IBN M_" for "_ $P(IB(0),U ,1)_" is n ot a valid Insurance Co." D ER ROR G ASK1
	1063	;
	1064	S IBMRA=0
	1065	I $P(IBIN S,U,2)="N" S IBQ=0 D G:IBQ NE XTP
	1066	. I $$MCR WNR^IBEFUN C(IBINSN) D Q
	1067	.. ; Chec k if a val id tert in s if MCR W NR seconda ry
	1068	.. I IBCO BN'>2 D
	1069	... N Z
	1070	... S Z=+ $P(IB("M") ,U,IBCOBN+ 1)
	1071	... I Z,$ D(^DIC(36, Z,0)),$P(^ (0),U,2)'= "N" S IBMR A=1,IBNM=$ P(IBNM," " )_"-MRA.On ly"
	1072	.. I 'IBM RA S IBER= "MEDICARE will not r eimburse a nd no furt her valid insurance for bill" D ERROR S IBQ=1
	1073	. S IBER= $P(IB(0),U ,1)_" "_IB NM_", "_$P (IBINS,U,1 )_", will not Reimbu rse" D ERR OR S IBQ=1
	1074	;
	1075	; If proc essing in silent mod e, skip ov er the fol lowing rea ds
	1076	I $G(IBSI LENT) G SK IP
	1077	;
	1078	W !!
	1079	S DIR("?" )="Enter Y es to "_$S ('$G(IBMRA O):"create a new bil l in the b ill series for this care. The new bill will be th e "_$P(IBN M," ")_" b ill ",1:"e nter the M RA informa tion and c hange the payer to t he "_$P($P (IBNM,"-") ," ")_" pa yer ")
	1080	S DIR("?" )=DIR("?") _$S('IBMRA :"with the "_IBNM_" responsibl e for paym ent.",1:"a nd will re quest an M RA from ME DICARE.")
	1081	S DIR(0)= "YO",DIR(" A")=$S('$G (IBMRAO):" Copy "_$P( IB(0),U,1) _" for a b ill to the ",1:"Chan ge payer o n bill "_$ P(IB(0),U, 1)_" to ") _IBNM_", " _$P(IBINS, U,1) D ^DI R K DIR I Y'=1 S IBS ECHK=1 G A SK1
	1082	;
	1083	W !
	1084	S IBQ=0
	1085	I '$G(IBM RAO) D G: IBQ ASK1
	1086	. N Z
	1087	. S DIR(" ?")="Enter the amoun t of the p ayment fro m the paye r of the " _IBNMOLD_" bill."
	1088	. S DIR(" ?")=DIR("? ")_" This will be a dded to th e new bill as a prio r payment and subtra cted from the charge s due for the new bi ll."
	1089	. S DIR(" A")="Prior Payment f rom "_$P(I B(0),U,1)_ " "_IBNMOL D_" Payer, "_$P(IBIN SOLD,U,1)_ ": "
	1090	. S Z=$$E OBTOT^IBCE U1(IBIFN,$ $COBN^IBCE F(IBIFN))
	1091	. S:Z DIR ("B")=Z
	1092	. S DIR(0 )="NOA^0:9 9999999:2"
	1093	. D ^DIR K DIR I Y= ""!$D(DIRU T) S IBQ=1
	1094	. K IBCOB
	1095	. S IBCOB ("U2",IBCO BN+2)=Y
	1096	. Q
	1097	;
	1098	SKIP ; Jum p here if skipping o ver the pr eceeding r eads
	1099	;
	1100	; If paye r is Medic are (WNR) update pay er sequenc e and quit
	1101	I IBMRAO! ($G(IBSTSM )=1) D I $G(IBSTSM) '=1 G END
	1102	. N IBPRT OT,IBTOTCH G,IBPTRESP
	1103	. S IBTOT CHG=0
	1104	. ;
	1105	. ; Get T otal Charg es from BI LLS/CLAIMS (#399) fi le
	1106	. S IBTOT CHG=$P($G( ^DGCR(399, IBIFN,"U1" )),U,1)
	1107	. ; Calcu late Patie nt Respons ibility fo r Bill
	1108	. ; IB2. 0447 If c laim's typ e of plan has effect ive date m ultiple, u se those c alculation s
	1109	. ;S IBPT RESP=$$PRE OBTOT^IBCE U0(IBIFN,$ G(IBSTSM))
	1110	. ; Calcu late Patie nt Primary /Secondary Prior Pay ment (fiel d 218 or 2 19 of File 399)
	1111	. ; These fields ar e stored i n DGCR(399 ,IBIFN,"U2 ") pieces 4 and 5 re spectively
	1112	. ; Calcu late: Prio r Payment= Total Sub mitted Cha rges - Pat ient Respo nsibility
	1113	. S:$G(IB STSM)'=1 I BPTRESP=$S ($$MSEDT^I BCEMU4(IBI FN)'="":$$ MSPRE^IBCE MU4(IBIFN) ,1:$$PREOB TOT^IBCEU0 (IBIFN,$G( IBSTSM))), IBPRTOT=IB TOTCHG-IBP TRESP
	1114	. S:$G(IB STSM)=1 IB PRTOT=$$EO BTOT^IBCEU 1(IBIFN,$$ COBN^IBCEF (IBIFN)) ; Pat Resp f or non-med icare
	1115	. I IBPRT OT<0 S IBP RTOT=0 ; don't allow nega tive prior payment o r offset
	1116	. S IBCOB ("U2",IBCO BN+2)=IBPR TOT
	1117	. ; IB2. 0547 don' t change s tatus back to 1.5 if auto-crea ting secon dary or te rtiary in silent mod e
	1118	. ; D:$G( IBSTSM)'=1 COBCHG^IB CCC2(IBIFN ,IBMRAIO,. IBCOB)
	1119	. ; D STA T^IBCEMU2( IBIFN,1.5, 1) ; m ra eob sta tus update
	1120	. I $G(IB STSM)'=1 D COBCHG^IB CCC2(IBIFN ,IBMRAIO,. IBCOB),STA T^IBCEMU2( IBIFN,1.5, 1) ; m ra eob sta tus update
	1121	. I $G(IB SILENT) S IBERRMSG=" "
	1122	. Q
	1123	;
	1124	; We shou ld NOT get to here i n silent m ode .... j ust in cas e
	1125	I $G(IBSI LENT),$G(I BSTSM)'=1 G END ; currently only MCRW NR in sile nt mode
	1126	;
	1127	; Payer i s not Medi care (WNR) - Perform additiona l steps
	1128	S IBCOB(0 ,15)=""
	1129	S IBCOB(0 ,21)=$S(IB COBN=2:"S" ,IBCOBN=3: "T",1:"")
	1130	I IBCOB(0 ,21)="" G END
	1131	S IBCOB(" M1",IBCOBN +3)=IBIFN
	1132	S IBIDS(. 15)=IBIFN
	1133	D KVAR
	1134	G STEP2^I BCCC
	1135	;
	1136	END ;
	1137	Q
	1138	;
	1139	;
	1140	ASK1 ; If entering t hru EDI CO B processi ng, don't ask for ne w bill, qu it
	1141	I $G(IBCB ASK) G EXI T
	1142	G ASK
	1143	;
	1144	ERROR ; Di splay/Save error mes sage
	1145	I '$G(IBS ILENT) W ! ,IBER,!
	1146	E S IBER RMSG=IBER
	1147	S IBER=""
	1148	I $D(IBSE CHK) S IBS ECHK=1
	1149	Q
	1150	;
	1151	EXIT K IBC AN,IBCOB,I BU
	1152	KVAR K IBX ,IBY,IBI,I BIFN,DFN,I BDT,IB,IBC OBN,IBNMOL D,IBINSOLD ,IBNM,IBIN SN,IBINS,I BER,DIR,IB AC,IBAC1,I BV,X,Y,IBD ATA,IBT,IB ND0,DIRUT, IBCOBIL,IB MRA,IBMRAI ,IBMRAO,IB MRAIO,IBCB COPY
	1153	K ^UTILIT Y($J)
	1154	Q
	1155	;
	1156	DSPRB(IBIF N) ; displ ay related bills
	1157	;
	1158	D DSPRB^I BCCCB0(IBI FN) ; Code moved for size too big
	1159	Q
	1160	;
	1161	; ======= =======
	1162	;
	1163	; Copy a bill for R easonable Charges wi thout canc elling it, update ce rtain fiel ds
	1164	;
	1165	; there i s always b oth inpt i nst (creat ed first) and prof c harges, al ways need both bills
	1166	; there m ay be both outpt ins t (created first) an d prof cha rges, may not need b oth bills
	1167	; if bill ing by epi sode rathe r than by day (curre nt standar d) then ma y need mul tiple prof bills per day
	1168	;
	1169	; Inst bi lls are co pied to cr eate prof Bills auto matically
	1170	; Subsequ ent prof b ills may b e created if the use r wants th em
	1171	;
	1172	; Only th e first bi ll in the COB series of bills should be copied for the next prof bill
	1173	; The pri mary inst bill shoul d be copie d to get t he seconda ry inst bi ll
	1174	; The pri mary prof bill shoul d be copie d to get t he seconda ry prof bi ll
	1175	;
	1176	CTCOPY(IBI FN,IBMRA) ; based on the type of bill, c opy withou t cancelli ng
	1177	; IBMRA = 1 if an M RA bill an d copy for prof comp onents is desired
	1178	;
	1179	D CTCOPY^ IBCCCB0(IB IFN,$G(IBM RA)) ;Move d due to r outine siz e
	1180	Q
	1181	;
	1182
	1183
	1184	Routines
	1185	Activities
	1186	Routine Na me
	1187	IBCECOB2
	1188	Enhancemen t Category
	1189	New
	1190	Modify
	1191	Delete
	1192	No Change
	1193	RTM
	1194
	1195	Related Op tions
	1196	None
	1197	Related Ro utines
	1198	Routines “ Called By”
	1199	Routines “ Called”
	1200
	1201
	1202
	1203
	1204	Data Dicti onary (DD) Reference s
	1205
	1206	Related Pr otocols
	1207
	1208	Related In tegration Control Re gistration s (ICRs)
	1209	None
	1210	Data Passi ng
	1211	Input
	1212	Output Re ference
	1213	Both
	1214	Global Re ference
	1215	Local
	1216	Input Attr ibute Name and Defin ition
	1217	Name:
	1218	Definition :
	1219	Output Att ribute Nam e and Defi nition
	1220	Name:
	1221	Definition :
	1222	Current Lo gic
	1223	IBCECOB2 ; ALB/CXW - IB COB MAN AGEMENT SC REEN ;16-J UN-1999
	1224	;;2.0;INT EGRATED BI LLING;13 7,155,433, 432,447,48 8,516;21 -MAR-1994; Build 123
	1225	;;Per VA Directive 6402, this routine s hould not be modifie d.
	1226	;
	1227	EDI ;histo ry detail display
	1228	N IBIFN,I BDA
	1229	D SEL(.IB DA,1)
	1230	S IBDA=+$ O(IBDA(0)) ,IBIFN=+$G (IBDA(IBDA ))
	1231	D EDI1(IB IFN)
	1232	S VALMBCK ="R"
	1233	Q
	1234	;
	1235	EDI1(IBIFN ) ;
	1236	N DFN
	1237	Q:'IBIFN
	1238	S DFN=$P( $G(^DGCR(3 99,IBIFN,0 )),U,2)
	1239	D EN^VALM ("IBJT EDI STATUS")
	1240	K:$D(IBFA STXT) IBFA STXT
	1241	Q
	1242	;
	1243	EDI2(IBIFN ) ;
	1244	N DFN
	1245	Q:'IBIFN
	1246	S DFN=$P( $G(^DGCR(3 99,IBIFN,0 )),U,2)
	1247	D EN^VALM ("IBJT EDI STATUS AL ONE")
	1248	K:$D(IBFA STXT) IBFA STXT
	1249	Q
	1250	;
	1251	CSA ;claim s status a waiting re solution
	1252	N IBDAX
	1253	D EN^IBCE CSA
	1254	I $D(IBFA STXT) K IB FASTXT
	1255	S VALMBCK ="R"
	1256	Q
	1257	;
	1258	RVEOB ;Rev iew EOB
	1259	D FULL^VA LM1 W !
	1260	N IBDA,IB IFN,IBCMT, IBSEL
	1261	D SEL(.IB DA,1)
	1262	S IBSEL=+ $O(IBDA(0) )
	1263	S IBDA=$G (IBDA(IBSE L))
	1264	S IBIFN=$ P(IBDA,U), IBDA=$P(IB DA,U,3)
	1265	I 'IBIFN G VEOBQ
	1266	S IBCMT=$ G(^TMP("IB CECOB1",$J ,IBSEL))
	1267	I IBCMT'= "" D EN^VA LM("IBCEM MRA REVIEW ")
	1268	VEOBQ K ^T MP("IBCECO C",$J)
	1269	S VALMBCK ="R"
	1270	Q
	1271	;
	1272	TPJI ;Thir d Party jo int Inquir y
	1273	N IBDA,IB IFN
	1274	D SEL(.IB DA,1)
	1275	S IBDA=+$ O(IBDA(0)) ,IBIFN=+$G (IBDA(IBDA ))
	1276	I IBDA="" G TPJIQ
	1277	D TPJI1(I BIFN)
	1278	TPJIQ S VA LMBCK="R"
	1279	Q
	1280	;
	1281	TPJI1(IBIF N) ;
	1282	N DFN,IBN OTPJI
	1283	Q:'IBIFN
	1284	S DFN=$P( $G(^DGCR(3 99,IBIFN,0 )),U,2),IB NOTPJI=1
	1285	D EN^VALM ("IBJT CLA IM INFO")
	1286	K:$D(IBFA STXT) IBFA STXT
	1287	Q
	1288	;
	1289	PBILL ;Pri nt bill
	1290	N IBIFN,I BDA,IBRESU B
	1291	D SEL(.IB DA,1)
	1292	S IBDA=$O (IBDA(0)), IBIFN=+$G( IBDA(+IBDA ))
	1293	I IBDA="" G PBOUT
	1294	S IBRESUB =$$RESUB^I BCECSA4(IB IFN,1,"P")
	1295	I IBRESUB '>0 W !,*7 ,"This is not a tran smittable bill or re view not n eeded" D P AUSE^VALM1 G PBOUT
	1296	I IBRESUB =2 D G PB OUT
	1297	. N IB364
	1298	. S IB364 =+$P($G(IB DA(IBDA)), U,2)
	1299	. D PRINT 1^IBCEM03( IBIFN,.IBD A,IB364)
	1300	D PBILL1( IBIFN)
	1301	PBOUT S VA LMBCK="R"
	1302	Q
	1303	;
	1304	PMRA ;Prin t MRA
	1305	N IBIFN,I BDA,IBDAX
	1306	D SEL(.IB DA,1)
	1307	S IBDA=$O (IBDA(0)), IBIFN=+$G( IBDA(+IBDA )),IBDAX=$ P(IBDA(+IB DA),U,3)
	1308	G:'IBIFN PRMQ
	1309	I '$G(IBM RANOT),$D( ^IBM(361.1 ,IBDAX,"ER R")),'$$WA RNMSE G PR MQ ; Claim co ntains Mes sage Stora ge Errors
	1310	D MRA^IBC EMRAA(.IBI FN)
	1311	PRMQ S VAL MBCK="R"
	1312	Q
	1313	PBILL1(IBI FN) ;
	1314	N IBAC1,I BAC,DFN
	1315	Q:'IBIFN
	1316	S DFN=$P( $G(^DGCR(3 99,IBIFN,0 )),U,2)
	1317	S IBAC=4, IBAC1=1
	1318	D 4^IBCB1
	1319	D FULL^VA LM1,PAUSE^ VALM1
	1320	Q
	1321	;
	1322	CANCEL ;Ca ncel bill
	1323	; IBDA(IB DA)=IBIFN^ IB364^ien of 361.1^u ser select ion seq^us er name~du z#
	1324	;
	1325	N IBIFN,I BDA,IB364, IBEOBIFN,X ,IBDENCT
	1326	;
	1327	; Check f or securit y key
	1328	I '$$KCHK ^XUSRB("IB AUTHORIZE ") D G CA NCELQ
	1329	. D FULL^ VALM1 S VA LMBCK="R"
	1330	. W !!?5, "You don't hold the proper sec urity key to access this funct ion."
	1331	. W !?5," The necess ary key is IB AUTHOR IZE. Plea se see you r manager. "
	1332	. D PAUSE ^VALM1
	1333	. Q
	1334	;
	1335	D SEL(.IB DA,1)
	1336	S IBDA=$O (IBDA(0)), IBIFN=+$G( IBDA(+IBDA )),IB364=$ P($G(IBDA( +IBDA)),U, 2)
	1337	S IBEOBIF N=$P($G(IB DA(+IBDA)) ,U,3)
	1338	;
	1339	; IB2.0 432 - if n ot mra, on ly allow c ancel of d enied clai ms. If no EOB, chec k AR statu s instead
	1340	I 'IBEOBI FN,$G(IBMR ANOT)=1,$P ($$ARSTATA ^IBJTU4(IB IFN),U)="C OLLECTED/C LOSED" D G CANCELQ
	1341	. D FULL^ VALM1 S VA LMBCK="R"
	1342	. W !!,*7 ,"You can only cance l denied c laims. Th is claim i s in a COL LECTED/CLO SED status "
	1343	. W !,"Us e Remove A ction to r emove clai m from thi s worklist ."
	1344	. D PAUSE ^VALM1
	1345	. Q
	1346	;
	1347	; IB2.0 432 - if n ot mra, on ly allow c ancel of c laims with multiple EOBS if no ne have pr ocessed.
	1348	I $G(IBMR ANOT)=1,'$ $DENCHK(IB IFN,.IBDEN CT),$G(IBD ENCT)>1 D G CANCELQ
	1349	. D FULL^ VALM1 S VA LMBCK="R"
	1350	. W !!,*7 ,"Multiple EOBs exis t for this claim and at least one has EO B status o f PROCESSE D."
	1351	. W !,"Us e Remove A ction to r emove clai m from thi s worklist ."
	1352	. D PAUSE ^VALM1
	1353	. Q
	1354	;
	1355	; IB2.0 432 - if n ot mra, on ly allow c ancel of d enied clai ms
	1356	I IBEOBIF N,$G(IBMRA NOT)=1,$P( $G(^IBM(36 1.1,IBEOBI FN,0)),U,1 3)'=2 D G CANCELQ
	1357	. D FULL^ VALM1 S VA LMBCK="R"
	1358	. W !!?5, *7,"You ca n only can cel denied claims."
	1359	. D PAUSE ^VALM1
	1360	. Q
	1361	;
	1362	I IBDA D
	1363	. I '$$LO CK^IBCEU0( 361.1,IBEO BIFN) Q
	1364	. D CANCE L^IBCEM3(. IBDA,IBIFN ,IB364)
	1365	. D UNLOC K^IBCEU0(3 61.1,IBEOB IFN)
	1366	S VALMBCK ="R"
	1367	;
	1368	; for non -MRA claim s cancelle d from wor klist, set field 38
	1369	I $G(IBMR ANOT)=1,$P ($G(^DGCR( 399,IBIFN, 0)),U,13)= 7 S X=$$WL RMVF^IBCEC OB1($S($G( IBIFN)'="" :IBIFN,1:+ $G(IBDA(IB DA))),"CA" )
	1370	I $G(IBDA )'="" D BL D^IBCECOB1
	1371	CANCELQ Q
	1372	;
	1373	CRD ; Corr ect Reject ed/Denied claim prot ocol actio n
	1374	N IBCNCRD
	1375	S IBCNCRD =1
	1376	CLONE ; 'C opy/cancel bill' pro tocol acti on
	1377	N IBDA,IB Q,IBEOBIFN ,IBKEY,X,I BDENCT
	1378	;
	1379	; Check f or securit y key
	1380	;IB2.05 16/TAZ - R emove chec k for IB C LON
	1381	;I '$$KCH K^XUSRB("I B AUTHORIZ E") D G C LONEQ
	1382	;S IBKEY= $S($G(IBCN CRD)=1:"IB AUTHORIZE ",1:"IB CL ON")
	1383	S IBKEY=" IB AUTHORI ZE"
	1384	I '$$KCHK ^XUSRB(IBK EY) D G C LONEQ
	1385	. D FULL^ VALM1 S VA LMBCK="R"
	1386	. ;W !!?5 ,"You don' t hold the proper se curity key to access this func tion."
	1387	. ;W !?5, "The neces sary key i s IB AUTHO RIZE. Ple ase see yo ur manager ."
	1388	. W !!?5, "You must hold the " _IBKEY_" s ecurity ke y to acces s this fun ction."
	1389	. W !?5," Please see your mana ger."
	1390	. D PAUSE ^VALM1
	1391	. Q
	1392	;
	1393	D SEL(.IB DA,1)
	1394	S IBDA=$O (IBDA(""))
	1395	I IBDA="" G CLONEQ
	1396	;
	1397	; IB2.0 432 - if n ot mra, on ly allow c ancel of c laims with multiple EOBS if no ne have pr ocessed.
	1398	I $G(IBMR ANOT)=1,'$ $DENCHK(+I BDA(IBDA), .IBDENCT), $G(IBDENCT )>1 D G C ANCELQ
	1399	. D FULL^ VALM1 S VA LMBCK="R"
	1400	. W !!,*7 ,"Multiple EOBs exis t for this claim and at least one has EO B status o f PROCESSE D."
	1401	. W !,"Us e Remove A ction to r emove clai m from thi s worklist ."
	1402	. D PAUSE ^VALM1
	1403	. Q
	1404	;
	1405	S IBEOBIF N=$P($G(IB DA(+IBDA)) ,U,3)
	1406	I '$$LOCK ^IBCEU0(36 1.1,IBEOBI FN) G CLON EQ
	1407	D COPYCLO N(+$G(IBDA (IBDA)),$P ($G(IBDA(+ IBDA)),U,2 ),.IBQ)
	1408	D UNLOCK^ IBCEU0(361 .1,IBEOBIF N)
	1409	;
	1410	; for non -MRA claim s cloned o r correcte d from wor klist, set field 38
	1411	I $G(IBMR ANOT)=1,$G (IBQ)'="" S X=$$WLRM VF^IBCECOB 1(+$G(IBDA (IBDA)),$S ($G(IBCNCR D)=1:"CR", 1:"CL"))
	1412	;
	1413	CLONEQ ;
	1414	S VALMBCK ="R"
	1415	D:$G(IBQ) '="" BLD^I BCECOB1
	1416	Q
	1417	;
	1418	COPYCLON(I BIFN,IB364 ,IBQ) ; Ge neric entr y point fo r clone a bill from EDI proces sing
	1419	; IBIFN = original bill ien
	1420	; IB364 = the ien o f the tran smission b ill entry in file 36 4
	1421	; IBQ = I f bill is not cancel led, this is returne d as null
	1422	; - pass by reference -
	1423	;
	1424	N IBQUIT, IBCCCC,IBH V,Y,IBCAN, IBCE,IBDA, IBCNCOPY
	1425	;I '$$CAN CKS^IBCEM3 ("CC",IBIF N) S IBQ=" " G CCQ
	1426	I $G(IBCN CRD)'=1,'$ $CANCKS^IB CEM3("CC", IBIFN) S I BQ="" G CC Q
	1427	;
	1428	;S IBCAN= 2,IBCE("ED I")=1,Y=IB IFN,IBCCCC =0,IBHV("I BIFN")=IBI FN,IBHV("I BIFN1")="" ,IBCNCOPY= 1
	1429	S IBCAN=2 ,IBCE("EDI ")=1,Y=IBI FN,IBCCCC= 0,IBHV("IB IFN")=IBIF N,IBHV("IB IFN1")=""
	1430	I $G(IBCN CRD)'=1 S IBCNCOPY=1 D ^IBCCC
	1431	I $G(IBCN CRD)=1 D C RD^IBCCC
	1432	;D ^IBCCC
	1433	S IBIFN=I BHV("IBIFN ")
	1434	K IBCE("E DI") S IBQ =1
	1435	I $P($G(^ DGCR(399,I BIFN,0)),U ,13)'=7 S IBQ=""
	1436	I IBHV("I BIFN1") D
	1437	. N IBU
	1438	. S IBU=" R"
	1439	. S IBNIE N=+IBHV("I BIFN1")
	1440	. I "23"' [$P($G(^DG CR(399,+IB HV("IBIFN1 "),0)),U,1 3) D
	1441	.. W:'$G( IBCEAUTO) !,*7,"Plea se note: t he new bil l was not AUTHORIZED .",!,"It c an only be accessed now via th e normal, non-EDI fu nctions.", !,"Status of new bil l is ",$$E XPAND^IBTR E(399,.13, $P(^DGCR(3 99,IBHV("I BIFN1"),0) ,U,13)) S IBU="C"
	1442	. D UPDED I^IBCEM(IB 364,IBU)
	1443	;
	1444	I '$G(IBC EAUTO) D P AUSE^VALM1
	1445	CCQ Q
	1446	;
	1447	PRO ; Copy for secon dary/terti ary bill
	1448	N VALMY,I BDA,Z,IBIF N,IBIFNH,I B364,IBCE, IBNCN
	1449	;I '$P($G (^IBE(350. 9,1,8)),U, 12) D G P ROQ
	1450	I '$P($G( ^IBE(350.9 ,1,8)),U,1 2),$G(IBMR ANOT)'=1 D G PROQ
	1451	. D FULL^ VALM1
	1452	. W !!?5, "MRA's may not be pr ocessed at this time ."
	1453	. W !?5," The IB sit e paramete r ""Allow MRA Proces sing?"" is set to NO ."
	1454	. D PAUSE ^VALM1
	1455	. Q
	1456	D SEL(.IB DA,1)
	1457	S Z=$O(IB DA(0)),Z=$ G(IBDA(+Z) ) G:'Z PRO Q
	1458	S IBIFN=$ P(Z,U),IB3 64=$P(Z,U, 2),IBDA=$P (Z,U,3),IB IFNH=IBIFN
	1459	I 'IBIFN G PROQ
	1460	I '$G(IBM RANOT),$D( ^IBM(361.1 ,IBDA,"ERR ")),'$$WAR NMSE G PRO Q ; Claim con tains Mess age Storag e Errors
	1461	I '$$LOCK ^IBCEU0(36 1.1,IBDA) G PROQ
	1462	D COBCOPY (IBIFN,IB3 64,2,IBDA, "BLD^IBCEC OB1",.IBNC N)
	1463	D UNLOCK^ IBCEU0(361 .1,IBDA)
	1464	;
	1465	; for non -MRA claim s copied f rom work l ist, set f ield 38
	1466	I $G(IBMR ANOT)=1,$G (IBNCN)'=" ",($G(IBNC N)'=$G(IBI FN)) D
	1467	.S X=$$WL RMVF^IBCEC OB1($G(IBI FN),"PC")
	1468	.;I $P($G (^DGCR(399 ,+IBNCN,"S ")),U,9)'= 1 D
	1469	.;.W:'$G( IBCEAUTO) !,*7,"Plea se note: t he new bil l was not AUTHORIZED .",!,"It c an only be accessed now via th e normal, non-EDI fu nctions.", !,"Status of new bil l is ",$$E XPAND^IBTR E(399,.13, $P(^DGCR(3 99,IBNCN,0 ),U,13))
	1470	.;.D PAUS E^VALM1
	1471	.D:$G(IBM RANOT)=1 B LD^IBCECOB 1
	1472	.Q
	1473	;
	1474	PROQ S VAL MBCK="R"
	1475	Q
	1476	;
	1477	COBCOPY(IB IFN,IB364, IBFROM,IBI EN,IBBLD,I BNCN) ; Ge neric entr y point fo r EDI COB copy
	1478	; IBIFN = original bill ien
	1479	; IB364 = the ien o f the tran smission b ill entry in file 36 4
	1480	; IBFROM = 1 if cal led from C SA, 2 if c alled from COB/EOB p rocessing
	1481	; IBIEN = entry in 361 (IBFRO M=1) or 36 1.1 (IBFRO M=2) being processed
	1482	; IBBLD = the name of the ent rypoint th at will re build the display
	1483	; IBNCN = by refere nce, retur ns the new claim ien if user c ompleted t he Copy pr ocess
	1484	;
	1485	N IBCBASK ,IBCBCOPY, IBCAN,IBIF NH,IBNSTAT ,IBOSTAT,I BPRCOB,IBS ECHK,IBLMV AR,IBAC,IB MRAIEN,IBD A,IBAUTO
	1486	N IBCOB,I BCOBIL,IBC OBN,IBINS, IBINSN,IBI NSOLD,IBMR AIO,IBMRAO ,IBNMOLD,I BQUIT
	1487	S (IBCBAS K,IBCBCOPY ,IBCAN,IBA UTO)=1,(IB PRCOB,IBSE CHK)=0,(IB MRAIEN,IBD A)=IBIEN
	1488	I $G(IBMR ANOT)'=1,' IB364!'IBI FN W !,"Tr ansmission record is missing f or this bi ll" D PAUS E^VALM1 G COBCOPX
	1489	;
	1490	S IBIFNH= IBIFN
	1491	I IBFROM= 2 S IBPRCO B=1
	1492	; IB2.0 447 Check PR to incl ude excess and perce ntages whe re applica ble
	1493	;I $S($G( IBMRANOT)= 1:$$TOT(IB IFN)'>0,1: $$PREOBTOT ^IBCEU0(IB IFN,$G(IBM RANOT))'>0 ) D G COB COPX
	1494	I $$TOT(I BIFN,$G(IB MRANOT))'> 0 D G COB COPX
	1495	. D FULL^ VALM1
	1496	. W !!?5, "There is no "_$S($G (IBMRANOT) =1:"balanc e remainin g",1:"pati ent respon sibility a nd/or exce ss charges ")_" for t his claim. "
	1497	. W !?5," This claim may not b e processe d."
	1498	. D PAUSE ^VALM1
	1499	. Q
	1500	;
	1501	I $G(IBDA )'="",$P($ G(^IBM(361 .1,IBDA,0) ),U,16)="1 .5" D G C OBCOPX
	1502	. W !!,"T his claim has alread y been pro cessed as a sec/tert claim."
	1503	. W !,"Yo u will nee d to compl ete the au thorizatio n process for this c laim."
	1504	. D PAUSE ^VALM1
	1505	. D AUTH
	1506	. Q
	1507	;
	1508	; If mult iple EOBs and one is processed , make sur e collecte d closed.
	1509	I $G(IBMR ANOT),$$CC CHK(IBIFN) <0 D G CO BCOPX
	1510	. W !,"Mu ltiple EOB s exist fo r this cla im and at least one has EOB st atus of PR OCESSED."
	1511	. W !,"Cl aim cannot be sent t o next pay er until A R status i s Collecte d/Closed."
	1512	. D PAUSE ^VALM1
	1513	. Q
	1514	;
	1515	; Get out if no nex t payer
	1516	I '$P($G( ^DGCR(399, IBIFN,"I"_ ($$COBN^IB CEF(IBIFN) +1))),U,1) D G COBC OPX
	1517	. W !,"Th ere is no next payer for this bill"
	1518	. D PAUSE ^VALM1
	1519	. Q
	1520	;
	1521	D DSPRB^I BCCCB0(IBI FN) ; display related b ills
	1522	S IBCE("E DI")=1
	1523	D CHKB^IB CCCB ; process COB, crea te seconda ry bill
	1524	S IBNCN=$ G(IBCE("ED I","NEW")) ; get new claim ien
	1525	S IBIFN=I BIFNH
	1526	I IBSECHK G COBCOPX
	1527	;
	1528	; if user came from CBW, no n eed to vie w and auth orize a 2n d time (al ready happ ens in IBC CCB)
	1529	Q:$G(IBMR ANOT)=1
	1530	S IBV=1 D VIEW^IBCB 2 ; display billing s creens
	1531	D AUTH ; authori ze bill
	1532	COBCOPX ;
	1533	Q
	1534	;
	1535	AUTH ; pro cedure to authorize the claim and refres h the scre en
	1536	K ^UTILIT Y($J) S IB AC=1,IBQUI T=0 D 3^IB CB1
	1537	I '$D(IOU ON)!'$D(IO RVON) D EN S^%ZISS
	1538	I $P($G(^ IBM(361.1, IBMRAIEN,0 )),U,16)=3 D UPDEDI^ IBCEM(IB36 4,"Z")
	1539	I $G(IBBL D)'="" D @ IBBLD
	1540	D PAUSE^V ALM1
	1541	AUTHX ;
	1542	Q
	1543	;
	1544	RES ;Resub mit bill b y print
	1545	N IBDA,IB IFN,IB364
	1546	D SEL(.IB DA,1)
	1547	S IBDA=+$ O(IBDA(0)) ,IBIFN=+$G (IBDA(+IBD A)),IB364= +$P($G(IBD A(IBDA)),U ,2)
	1548	I 'IBIFN G RESQ
	1549	D PRINT1^ IBCEM03(IB IFN,.IBDA, IB364)
	1550	D PAUSE^V ALM1
	1551	I $G(IBDA )'="" D BL D^IBCECOB1
	1552	RESQ S VAL MBCK="R"
	1553	Q
	1554	;
	1555	EBI ;View an unautho rized tran smitted bi ll
	1556	N IBFLG,I BDA,IBIFN, IB364,DFN
	1557	K ^TMP($J ,"IBBILL")
	1558	D FULL^VA LM1
	1559	;
	1560	D SEL(.IB DA,1)
	1561	S IBDA=+$ O(IBDA("") )
	1562	S IBIFN=+ $G(IBDA(IB DA)),IB364 =+$P($G(IB DA(IBDA)), U,2),DFN=$ P($G(^DGCR (399,IBIFN ,0)),U,2)
	1563	G:'IBIFN EDITQ
	1564	S IBV=1 D VIEW^IBCB 2
	1565	I '$D(IOU ON)!'$D(IO RVON) D EN S^%ZISS
	1566	D BLD^IBC ECOB1
	1567	EDITQ S VA LMBCK="R"
	1568	Q
	1569	;
	1570	SEL(IBDA,O NE) ; Sele ct entry(s ) from lis t
	1571	; IBDA = array retu rned if se lections m ade
	1572	; IBDA (n)=ien of bill sele cted (file 399)
	1573	; ONE = i f set to 1 , only one selection can be ma de at a ti me
	1574	N IB
	1575	K IBDA
	1576	D FULL^VA LM1
	1577	D EN^VALM 2($G(XQORN OD(0)),$S( '$G(ONE):" ",1:"S"))
	1578	S IBDA=0 F S IBDA= $O(VALMY(I BDA)) Q:'I BDA S IBD A(IBDA)=$P ($G(^TMP(" IBCECOB",$ J,+IBDA)), U,2,6)
	1579	Q
	1580	;
	1581	EXIT ; Exi t out of C OB
	1582	D FASTEXI T^IBCEFG4
	1583	I $G(IBFA STXT)=1 S IBFASTXT=5
	1584	Q
	1585	;
	1586	TOT(IBIFN, IBMRANOT) ; calculat e if any b alance rem aining on non-MRA cl aim
	1587	; IBIFN = claim ien
	1588	; IBMRANO T = MRW/CB W flag (1= user came from CBW) added wit h IB2.04 47
	1589	N IBPRTOT ,IBBLD,IBC BN,IBU2
	1590	I $G(IBMR ANOT)'=1 Q $S($$MSED T^IBCEMU4( IBIFN)'="" :$$MSPRE^I BCEMU4(IBI FN),1:$$PR EOBTOT^IBC EU0(IBIFN) )
	1591	; total u p the paye r paid amo unts, if t his is a 2 ndary clai m, be sure to accoun t for what the prima ry paid al so
	1592	S IBU2=$G (^DGCR(399 ,IBIFN,"U2 ")),IBCBN= $$COBN^IBC EF(IBIFN), IBPRTOT=$$ EOBTOT^IBC EU1(IBIFN, IBCBN)
	1593	S:IBPRTOT <0 IBPRTOT =0 ; don't allo w negative prior pay ment or of fset
	1594	S:IBCBN=2 IBPRTOT=I BPRTOT+$P( IBU2,U,4)
	1595	S:IBCBN=3 IBPRTOT=I BPRTOT+$P( IBU2,U,4)+ $P(IBU2,U, 5)
	1596	S:IBPRTOT <0 IBPRTOT =0 ; don't allo w negative prior pay ment or of fset
	1597	; Subtrac t payer pa id amount from Total Charges f rom BILLS/ CLAIMS (#3 99) file, don't allo w neg
	1598	S IBBLD=$ P($G(^DGCR (399,IBIFN ,"U1")),U, 1)-IBPRTOT
	1599	S:IBBLD<0 IBBLD=0
	1600	Q IBBLD
	1601	;
	1602	CCCHK(IBIF N) ; If th ere are mu ltiple EOB S on file for this c laim, then one of th em must be processed and AR st atus must be collect ed closed to process .
	1603	; returns 1 if true
	1604	; 0 if ther e are not multiple E OBs or mul itple EOBs and none are proces sed (all d enials)
	1605	; -1 if fals e
	1606	N IBDA,IB CT,IBPROC, IBARSTAT,I BEOBNDX,IB EOB
	1607	S IBCT=0, IBPROC=0
	1608	F IBEOBND X="B","C" D
	1609	.S IBDA=0 F S IBDA =$O(^IBM(3 61.1,IBEOB NDX,IBIFN, IBDA)) Q:' +IBDA D
	1610	..Q:$D(IB EOB(IBDA))
	1611	..Q:$P($G (^IBM(361. 1,IBDA,0)) ,U,4)=1 ; only co unt EOBs
	1612	..S IBEOB (IBDA)="", IBCT=IBCT+ 1
	1613	..I $P($G (^IBM(361. 1,IBDA,0)) ,U,13)=1 S IBPROC=1
	1614	I IBCT<2 Q 0 ; les s than 2 E OBs
	1615	I 'IBPROC Q 0 ; no EOBs with status pr ocessed
	1616	S IBARSTA T=$$ARSTAT A^IBJTU4(I BIFN) ; g et status of AR
	1617	I $P(IBAR STAT,U)="C OLLECTED/C LOSED" Q 1
	1618	Q -1
	1619	;
	1620	DENCHK(IBI FN,IBCT) ; Make sure all EOBs from this claim are denied.
	1621	; Input: IBIFN - IE N to 399
	1622	; IBCT - by reference. Return co unt of EOB s.
	1623	; Output: returns 1 if there is at leas t one EOB and that n one of the EOBS are processed.
	1624	; otherwi se 0
	1625	;
	1626	N IBDA,IB PROC,IBEOB NDX,IBEOB
	1627	S IBCT=0, IBPROC=0
	1628	F IBEOBND X="B","C" D
	1629	.S IBDA=0 F S IBDA =$O(^IBM(3 61.1,IBEOB NDX,IBIFN, IBDA)) Q:' +IBDA D
	1630	..Q:$D(IB EOB(IBDA))
	1631	..Q:$P($G (^IBM(361. 1,IBDA,0)) ,U,4)=1 ; only co unt EOBs
	1632	..S IBEOB (IBDA)="", IBCT=IBCT+ 1
	1633	..I $P($G (^IBM(361. 1,IBDA,0)) ,U,13)=1 S IBPROC=1
	1634	I IBCT,'I BPROC Q 1 ; there i s at least one EOB a nd none of the EOBS are proces sed.
	1635	Q 0 ;
	1636	;
	1637	WARNMSE() ; Display MSE Warnin g and chec k if we sh ould conti nue.
	1638	D FULL^VA LM1
	1639	N DIR,X,Y
	1640	S DIR("A" ,1)="WARNI NG : The M RA for thi s claim ca used a Dat a Mismatch /Message S torage Err or."
	1641	S DIR("A" ,2)="If yo u continue , the seco ndary clai m may not contain th e correct data."
	1642	S DIR("A" )="Do you wish to co ntinue? ", DIR("B")=" NO",DIR(0) ="YA" D ^D IR
	1643	I Y>0 Q 1 ; Okay to continu e.
	1644	Q 0 ;
	1645	Modified L ogic (Chan ges are in bold)
	1646	IBCECOB2 ; ALB/CXW - IB COB MAN AGEMENT SC REEN ;16-J UN-1999
	1647	;;2.0;INT EGRATED BI LLING;13 7,155,433, 432,447,48 8,516;21 -MAR-1994; Build 123
	1648	;;Per VA Directive 6402, this routine s hould not be modifie d.
	1649	;
	1650	EDI ;histo ry detail display
	1651	N IBIFN,I BDA
	1652	D SEL(.IB DA,1)
	1653	S IBDA=+$ O(IBDA(0)) ,IBIFN=+$G (IBDA(IBDA ))
	1654	D EDI1(IB IFN)
	1655	S VALMBCK ="R"
	1656	Q
	1657	;
	1658	EDI1(IBIFN ) ;
	1659	N DFN
	1660	Q:'IBIFN
	1661	S DFN=$P( $G(^DGCR(3 99,IBIFN,0 )),U,2)
	1662	D EN^VALM ("IBJT EDI STATUS")
	1663	K:$D(IBFA STXT) IBFA STXT
	1664	Q
	1665	;
	1666	EDI2(IBIFN ) ;
	1667	N DFN
	1668	Q:'IBIFN
	1669	S DFN=$P( $G(^DGCR(3 99,IBIFN,0 )),U,2)
	1670	D EN^VALM ("IBJT EDI STATUS AL ONE")
	1671	K:$D(IBFA STXT) IBFA STXT
	1672	Q
	1673	;
	1674	CSA ;claim s status a waiting re solution
	1675	N IBDAX
	1676	D EN^IBCE CSA
	1677	I $D(IBFA STXT) K IB FASTXT
	1678	S VALMBCK ="R"
	1679	Q
	1680	;
	1681	RVEOB ;Rev iew EOB
	1682	D FULL^VA LM1 W !
	1683	N IBDA,IB IFN,IBCMT, IBSEL
	1684	D SEL(.IB DA,1)
	1685	S IBSEL=+ $O(IBDA(0) )
	1686	S IBDA=$G (IBDA(IBSE L))
	1687	S IBIFN=$ P(IBDA,U), IBDA=$P(IB DA,U,3)
	1688	I 'IBIFN G VEOBQ
	1689	S IBCMT=$ G(^TMP("IB CECOB1",$J ,IBSEL))
	1690	I IBCMT'= "" D EN^VA LM("IBCEM MRA REVIEW ")
	1691	VEOBQ K ^T MP("IBCECO C",$J)
	1692	S VALMBCK ="R"
	1693	Q
	1694	;
	1695	TPJI ;Thir d Party jo int Inquir y
	1696	N IBDA,IB IFN
	1697	D SEL(.IB DA,1)
	1698	S IBDA=+$ O(IBDA(0)) ,IBIFN=+$G (IBDA(IBDA ))
	1699	I IBDA="" G TPJIQ
	1700	D TPJI1(I BIFN)
	1701	TPJIQ S VA LMBCK="R"
	1702	Q
	1703	;
	1704	TPJI1(IBIF N) ;
	1705	N DFN,IBN OTPJI
	1706	Q:'IBIFN
	1707	S DFN=$P( $G(^DGCR(3 99,IBIFN,0 )),U,2),IB NOTPJI=1
	1708	D EN^VALM ("IBJT CLA IM INFO")
	1709	K:$D(IBFA STXT) IBFA STXT
	1710	Q
	1711	;
	1712	PBILL ;Pri nt bill
	1713	N IBIFN,I BDA,IBRESU B
	1714	D SEL(.IB DA,1)
	1715	S IBDA=$O (IBDA(0)), IBIFN=+$G( IBDA(+IBDA ))
	1716	I IBDA="" G PBOUT
	1717	S IBRESUB =$$RESUB^I BCECSA4(IB IFN,1,"P")
	1718	I IBRESUB '>0 W !,*7 ,"This is not a tran smittable bill or re view not n eeded" D P AUSE^VALM1 G PBOUT
	1719	I IBRESUB =2 D G PB OUT
	1720	. N IB364
	1721	. S IB364 =+$P($G(IB DA(IBDA)), U,2)
	1722	. D PRINT 1^IBCEM03( IBIFN,.IBD A,IB364)
	1723	D PBILL1( IBIFN)
	1724	PBOUT S VA LMBCK="R"
	1725	Q
	1726	;
	1727	PMRA ;Prin t MRA
	1728	N IBIFN,I BDA,IBDAX
	1729	D SEL(.IB DA,1)
	1730	;JRA Fix <UNDEFINED > error oc curring wh en IBDA(+I BDA) does not exist. Also, ens ure that I BDAX'=""
	1731	; since i t's used a s a subscr ipt to ^IB M.
	1732	;S IBDA=$ O(IBDA(0)) ,IBIFN=+$G (IBDA(+IBD A)),IBDAX= $P(IBDA(+I BDA),U,3) ;JRA ';'
	1733	S IBDA=$O (IBDA(0)), IBIFN=+$G( IBDA(+IBDA )),IBDAX=+ $P($G(IBDA (+IBDA)),U ,3) ;JRA Add $G to SET of IBD AX - also +$P
	1734	G:'IBIFN PRMQ
	1735	I '$G(IBM RANOT),$D( ^IBM(361.1 ,IBDAX,"ER R")),'$$WA RNMSE G PR MQ ; Cla im contain s Message Storage Er rors
	1736	D MRA^IBC EMRAA(.IBI FN)
	1737	PRMQ S VAL MBCK="R"
	1738	Q
	1739	PBILL1(IBI FN) ;
	1740	N IBAC1,I BAC,DFN
	1741	Q:'IBIFN
	1742	S DFN=$P( $G(^DGCR(3 99,IBIFN,0 )),U,2)
	1743	S IBAC=4, IBAC1=1
	1744	D 4^IBCB1
	1745	D FULL^VA LM1,PAUSE^ VALM1
	1746	Q
	1747	;
	1748	CANCEL ;Ca ncel bill
	1749	; IBDA(IB DA)=IBIFN^ IB364^ien of 361.1^u ser select ion seq^us er name~du z#
	1750	;
	1751	N IBIFN,I BDA,IB364, IBEOBIFN,X ,IBDENCT
	1752	;
	1753	; Check f or securit y key
	1754	I '$$KCHK ^XUSRB("IB AUTHORIZE ") D G CA NCELQ
	1755	. D FULL^ VALM1 S VA LMBCK="R"
	1756	. W !!?5, "You don't hold the proper sec urity key to access this funct ion."
	1757	. W !?5," The necess ary key is IB AUTHOR IZE. Plea se see you r manager. "
	1758	. D PAUSE ^VALM1
	1759	. Q
	1760	;
	1761	D SEL(.IB DA,1)
	1762	S IBDA=$O (IBDA(0)), IBIFN=+$G( IBDA(+IBDA )),IB364=$ P($G(IBDA( +IBDA)),U, 2)
	1763	S IBEOBIF N=$P($G(IB DA(+IBDA)) ,U,3)
	1764	;
	1765	; IB2.0 432 - if n ot mra, on ly allow c ancel of d enied clai ms. If no EOB, chec k AR statu s instead
	1766	I 'IBEOBI FN,$G(IBMR ANOT)=1,$P ($$ARSTATA ^IBJTU4(IB IFN),U)="C OLLECTED/C LOSED" D G CANCELQ
	1767	. D FULL^ VALM1 S VA LMBCK="R"
	1768	. W !!,*7 ,"You can only cance l denied c laims. Th is claim i s in a COL LECTED/CLO SED status "
	1769	. W !,"Us e Remove A ction to r emove clai m from thi s worklist ."
	1770	. D PAUSE ^VALM1
	1771	. Q
	1772	;
	1773	; IB2.0 432 - if n ot mra, on ly allow c ancel of c laims with multiple EOBS if no ne have pr ocessed.
	1774	I $G(IBMR ANOT)=1,'$ $DENCHK(IB IFN,.IBDEN CT),$G(IBD ENCT)>1 D G CANCELQ
	1775	. D FULL^ VALM1 S VA LMBCK="R"
	1776	. W !!,*7 ,"Multiple EOBs exis t for this claim and at least one has EO B status o f PROCESSE D."
	1777	. W !,"Us e Remove A ction to r emove clai m from thi s worklist ."
	1778	. D PAUSE ^VALM1
	1779	. Q
	1780	;
	1781	; IB2.0 432 - if n ot mra, on ly allow c ancel of d enied clai ms
	1782	I IBEOBIF N,$G(IBMRA NOT)=1,$P( $G(^IBM(36 1.1,IBEOBI FN,0)),U,1 3)'=2 D G CANCELQ
	1783	. D FULL^ VALM1 S VA LMBCK="R"
	1784	. W !!?5, *7,"You ca n only can cel denied claims."
	1785	. D PAUSE ^VALM1
	1786	. Q
	1787	;
	1788	I IBDA D
	1789	. I '$$LO CK^IBCEU0( 361.1,IBEO BIFN) Q
	1790	. D CANCE L^IBCEM3(. IBDA,IBIFN ,IB364)
	1791	. D UNLOC K^IBCEU0(3 61.1,IBEOB IFN)
	1792	S VALMBCK ="R"
	1793	;
	1794	; for non -MRA claim s cancelle d from wor klist, set field 38
	1795	I $G(IBMR ANOT)=1,$P ($G(^DGCR( 399,IBIFN, 0)),U,13)= 7 S X=$$WL RMVF^IBCEC OB1($S($G( IBIFN)'="" :IBIFN,1:+ $G(IBDA(IB DA))),"CA" )
	1796	I $G(IBDA )'="" D BL D^IBCECOB1
	1797	CANCELQ Q
	1798	;
	1799	CRD ; Corr ect Reject ed/Denied claim prot ocol actio n
	1800	N IBCNCRD
	1801	S IBCNCRD =1
	1802	CLONE ; 'C opy/cancel bill' pro tocol acti on
	1803	N IBDA,IB Q,IBEOBIFN ,IBKEY,X,I BDENCT
	1804	;
	1805	; Check f or securit y key
	1806	;IB2.05 16/TAZ - R emove chec k for IB C LON
	1807	;I '$$KCH K^XUSRB("I B AUTHORIZ E") D G C LONEQ
	1808	;S IBKEY= $S($G(IBCN CRD)=1:"IB AUTHORIZE ",1:"IB CL ON")
	1809	S IBKEY=" IB AUTHORI ZE"
	1810	I '$$KCHK ^XUSRB(IBK EY) D G C LONEQ
	1811	. D FULL^ VALM1 S VA LMBCK="R"
	1812	. ;W !!?5 ,"You don' t hold the proper se curity key to access this func tion."
	1813	. ;W !?5, "The neces sary key i s IB AUTHO RIZE. Ple ase see yo ur manager ."
	1814	. W !!?5, "You must hold the " _IBKEY_" s ecurity ke y to acces s this fun ction."
	1815	. W !?5," Please see your mana ger."
	1816	. D PAUSE ^VALM1
	1817	. Q
	1818	;
	1819	D SEL(.IB DA,1)
	1820	S IBDA=$O (IBDA(""))
	1821	I IBDA="" G CLONEQ
	1822	;
	1823	; IB2.0 432 - if n ot mra, on ly allow c ancel of c laims with multiple EOBS if no ne have pr ocessed.
	1824	I $G(IBMR ANOT)=1,'$ $DENCHK(+I BDA(IBDA), .IBDENCT), $G(IBDENCT )>1 D G C ANCELQ
	1825	. D FULL^ VALM1 S VA LMBCK="R"
	1826	. W !!,*7 ,"Multiple EOBs exis t for this claim and at least one has EO B status o f PROCESSE D."
	1827	. W !,"Us e Remove A ction to r emove clai m from thi s worklist ."
	1828	. D PAUSE ^VALM1
	1829	. Q
	1830	;
	1831	S IBEOBIF N=$P($G(IB DA(+IBDA)) ,U,3)
	1832	I '$$LOCK ^IBCEU0(36 1.1,IBEOBI FN) G CLON EQ
	1833	D COPYCLO N(+$G(IBDA (IBDA)),$P ($G(IBDA(+ IBDA)),U,2 ),.IBQ)
	1834	D UNLOCK^ IBCEU0(361 .1,IBEOBIF N)
	1835	;
	1836	; for non -MRA claim s cloned o r correcte d from wor klist, set field 38
	1837	I $G(IBMR ANOT)=1,$G (IBQ)'="" S X=$$WLRM VF^IBCECOB 1(+$G(IBDA (IBDA)),$S ($G(IBCNCR D)=1:"CR", 1:"CL"))
	1838	;
	1839	CLONEQ ;
	1840	S VALMBCK ="R"
	1841	D:$G(IBQ) '="" BLD^I BCECOB1
	1842	Q
	1843	;
	1844	COPYCLON(I BIFN,IB364 ,IBQ) ; Ge neric entr y point fo r clone a bill from EDI proces sing
	1845	; IBIFN = original bill ien
	1846	; IB364 = the ien o f the tran smission b ill entry in file 36 4
	1847	; IBQ = I f bill is not cancel led, this is returne d as null
	1848	; - pass by reference -
	1849	;
	1850	N IBQUIT, IBCCCC,IBH V,Y,IBCAN, IBCE,IBDA, IBCNCOPY
	1851	;I '$$CAN CKS^IBCEM3 ("CC",IBIF N) S IBQ=" " G CCQ
	1852	I $G(IBCN CRD)'=1,'$ $CANCKS^IB CEM3("CC", IBIFN) S I BQ="" G CC Q
	1853	;
	1854	;S IBCAN= 2,IBCE("ED I")=1,Y=IB IFN,IBCCCC =0,IBHV("I BIFN")=IBI FN,IBHV("I BIFN1")="" ,IBCNCOPY= 1
	1855	S IBCAN=2 ,IBCE("EDI ")=1,Y=IBI FN,IBCCCC= 0,IBHV("IB IFN")=IBIF N,IBHV("IB IFN1")=""
	1856	I $G(IBCN CRD)'=1 S IBCNCOPY=1 D ^IBCCC
	1857	I $G(IBCN CRD)=1 D C RD^IBCCC
	1858	;D ^IBCCC
	1859	S IBIFN=I BHV("IBIFN ")
	1860	K IBCE("E DI") S IBQ =1
	1861	I $P($G(^ DGCR(399,I BIFN,0)),U ,13)'=7 S IBQ=""
	1862	I IBHV("I BIFN1") D
	1863	. N IBU
	1864	. S IBU=" R"
	1865	. S IBNIE N=+IBHV("I BIFN1")
	1866	. I "23"' [$P($G(^DG CR(399,+IB HV("IBIFN1 "),0)),U,1 3) D
	1867	.. W:'$G( IBCEAUTO) !,*7,"Plea se note: t he new bil l was not AUTHORIZED .",!,"It c an only be accessed now via th e normal, non-EDI fu nctions.", !,"Status of new bil l is ",$$E XPAND^IBTR E(399,.13, $P(^DGCR(3 99,IBHV("I BIFN1"),0) ,U,13)) S IBU="C"
	1868	. D UPDED I^IBCEM(IB 364,IBU)
	1869	;
	1870	I '$G(IBC EAUTO) D P AUSE^VALM1
	1871	CCQ Q
	1872	;
	1873	PRO ; Copy for secon dary/terti ary bill
	1874	N VALMY,I BDA,Z,IBIF N,IBIFNH,I B364,IBCE, IBNCN
	1875	;I '$P($G (^IBE(350. 9,1,8)),U, 12) D G P ROQ
	1876	I '$P($G( ^IBE(350.9 ,1,8)),U,1 2),$G(IBMR ANOT)'=1 D G PROQ
	1877	. D FULL^ VALM1
	1878	. W !!?5, "MRA's may not be pr ocessed at this time ."
	1879	. W !?5," The IB sit e paramete r ""Allow MRA Proces sing?"" is set to NO ."
	1880	. D PAUSE ^VALM1
	1881	. Q
	1882	D SEL(.IB DA,1)
	1883	S Z=$O(IB DA(0)),Z=$ G(IBDA(+Z) ) G:'Z PRO Q
	1884	S IBIFN=$ P(Z,U),IB3 64=$P(Z,U, 2),IBDA=$P (Z,U,3),IB IFNH=IBIFN
	1885	I 'IBIFN G PROQ
	1886	I '$G(IBM RANOT),$D( ^IBM(361.1 ,IBDA,"ERR ")),'$$WAR NMSE G PRO Q ; Claim con tains Mess age Storag e Errors
	1887	I '$$LOCK ^IBCEU0(36 1.1,IBDA) G PROQ
	1888	D COBCOPY (IBIFN,IB3 64,2,IBDA, "BLD^IBCEC OB1",.IBNC N)
	1889	D UNLOCK^ IBCEU0(361 .1,IBDA)
	1890	;
	1891	; for non -MRA claim s copied f rom work l ist, set f ield 38
	1892	I $G(IBMR ANOT)=1,$G (IBNCN)'=" ",($G(IBNC N)'=$G(IBI FN)) D
	1893	.S X=$$WL RMVF^IBCEC OB1($G(IBI FN),"PC")
	1894	.;I $P($G (^DGCR(399 ,+IBNCN,"S ")),U,9)'= 1 D
	1895	.;.W:'$G( IBCEAUTO) !,*7,"Plea se note: t he new bil l was not AUTHORIZED .",!,"It c an only be accessed now via th e normal, non-EDI fu nctions.", !,"Status of new bil l is ",$$E XPAND^IBTR E(399,.13, $P(^DGCR(3 99,IBNCN,0 ),U,13))
	1896	.;.D PAUS E^VALM1
	1897	.D:$G(IBM RANOT)=1 B LD^IBCECOB 1
	1898	.Q
	1899	;
	1900	PROQ S VAL MBCK="R"
	1901	Q
	1902	;
	1903	COBCOPY(IB IFN,IB364, IBFROM,IBI EN,IBBLD,I BNCN) ; Ge neric entr y point fo r EDI COB copy
	1904	; IBIFN = original bill ien
	1905	; IB364 = the ien o f the tran smission b ill entry in file 36 4
	1906	; IBFROM = 1 if cal led from C SA, 2 if c alled from COB/EOB p rocessing
	1907	; IBIEN = entry in 361 (IBFRO M=1) or 36 1.1 (IBFRO M=2) being processed
	1908	; IBBLD = the name of the ent rypoint th at will re build the display
	1909	; IBNCN = by refere nce, retur ns the new claim ien if user c ompleted t he Copy pr ocess
	1910	;
	1911	N IBCBASK ,IBCBCOPY, IBCAN,IBIF NH,IBNSTAT ,IBOSTAT,I BPRCOB,IBS ECHK,IBLMV AR,IBAC,IB MRAIEN,IBD A,IBAUTO
	1912	N IBCOB,I BCOBIL,IBC OBN,IBINS, IBINSN,IBI NSOLD,IBMR AIO,IBMRAO ,IBNMOLD,I BQUIT
	1913	S (IBCBAS K,IBCBCOPY ,IBCAN,IBA UTO)=1,(IB PRCOB,IBSE CHK)=0,(IB MRAIEN,IBD A)=IBIEN
	1914	I $G(IBMR ANOT)'=1,' IB364!'IBI FN W !,"Tr ansmission record is missing f or this bi ll" D PAUS E^VALM1 G COBCOPX
	1915	;
	1916	S IBIFNH= IBIFN
	1917	I IBFROM= 2 S IBPRCO B=1
	1918	; IB2.0 447 Check PR to incl ude excess and perce ntages whe re applica ble
	1919	;I $S($G( IBMRANOT)= 1:$$TOT(IB IFN)'>0,1: $$PREOBTOT ^IBCEU0(IB IFN,$G(IBM RANOT))'>0 ) D G COB COPX
	1920	I $$TOT(I BIFN,$G(IB MRANOT))'> 0 D G COB COPX
	1921	. D FULL^ VALM1
	1922	. W !!?5, "There is no "_$S($G (IBMRANOT) =1:"balanc e remainin g",1:"pati ent respon sibility a nd/or exce ss charges ")_" for t his claim. "
	1923	. W !?5," This claim may not b e processe d."
	1924	. D PAUSE ^VALM1
	1925	. Q
	1926	;
	1927	I $G(IBDA )'="",$P($ G(^IBM(361 .1,IBDA,0) ),U,16)="1 .5" D G C OBCOPX
	1928	. W !!,"T his claim has alread y been pro cessed as a sec/tert claim."
	1929	. W !,"Yo u will nee d to compl ete the au thorizatio n process for this c laim."
	1930	. D PAUSE ^VALM1
	1931	. D AUTH
	1932	. Q
	1933	;
	1934	; If mult iple EOBs and one is processed , make sur e collecte d closed.
	1935	I $G(IBMR ANOT),$$CC CHK(IBIFN) <0 D G CO BCOPX
	1936	. W !,"Mu ltiple EOB s exist fo r this cla im and at least one has EOB st atus of PR OCESSED."
	1937	. W !,"Cl aim cannot be sent t o next pay er until A R status i s Collecte d/Closed."
	1938	. D PAUSE ^VALM1
	1939	. Q
	1940	;
	1941	; Get out if no nex t payer
	1942	I '$P($G( ^DGCR(399, IBIFN,"I"_ ($$COBN^IB CEF(IBIFN) +1))),U,1) D G COBC OPX
	1943	. W !,"Th ere is no next payer for this bill"
	1944	. D PAUSE ^VALM1
	1945	. Q
	1946	;
	1947	D DSPRB^I BCCCB0(IBI FN) ; display related b ills
	1948	S IBCE("E DI")=1
	1949	D CHKB^IB CCCB ; process COB, crea te seconda ry bill
	1950	S IBNCN=$ G(IBCE("ED I","NEW")) ; get new claim ien
	1951	S IBIFN=I BIFNH
	1952	I IBSECHK G COBCOPX
	1953	;
	1954	; if user came from CBW, no n eed to vie w and auth orize a 2n d time (al ready happ ens in IBC CCB)
	1955	Q:$G(IBMR ANOT)=1
	1956	S IBV=1 D VIEW^IBCB 2 ; display billing s creens
	1957	D AUTH ; authori ze bill
	1958	COBCOPX ;
	1959	Q
	1960	;
	1961	AUTH ; pro cedure to authorize the claim and refres h the scre en
	1962	K ^UTILIT Y($J) S IB AC=1,IBQUI T=0 D 3^IB CB1
	1963	I '$D(IOU ON)!'$D(IO RVON) D EN S^%ZISS
	1964	I $P($G(^ IBM(361.1, IBMRAIEN,0 )),U,16)=3 D UPDEDI^ IBCEM(IB36 4,"Z")
	1965	I $G(IBBL D)'="" D @ IBBLD
	1966	D PAUSE^V ALM1
	1967	AUTHX ;
	1968	Q
	1969	;
	1970	RES ;Resub mit bill b y print
	1971	N IBDA,IB IFN,IB364
	1972	D SEL(.IB DA,1)
	1973	S IBDA=+$ O(IBDA(0)) ,IBIFN=+$G (IBDA(+IBD A)),IB364= +$P($G(IBD A(IBDA)),U ,2)
	1974	I 'IBIFN G RESQ
	1975	D PRINT1^ IBCEM03(IB IFN,.IBDA, IB364)
	1976	D PAUSE^V ALM1
	1977	I $G(IBDA )'="" D BL D^IBCECOB1
	1978	RESQ S VAL MBCK="R"
	1979	Q
	1980	;
	1981	EBI ;View an unautho rized tran smitted bi ll
	1982	N IBFLG,I BDA,IBIFN, IB364,DFN
	1983	K ^TMP($J ,"IBBILL")
	1984	D FULL^VA LM1
	1985	;
	1986	D SEL(.IB DA,1)
	1987	S IBDA=+$ O(IBDA("") )
	1988	S IBIFN=+ $G(IBDA(IB DA)),IB364 =+$P($G(IB DA(IBDA)), U,2),DFN=$ P($G(^DGCR (399,IBIFN ,0)),U,2)
	1989	G:'IBIFN EDITQ
	1990	S IBV=1 D VIEW^IBCB 2
	1991	I '$D(IOU ON)!'$D(IO RVON) D EN S^%ZISS
	1992	D BLD^IBC ECOB1
	1993	EDITQ S VA LMBCK="R"
	1994	Q
	1995	;
	1996	SEL(IBDA,O NE) ; Sele ct entry(s ) from lis t
	1997	; IBDA = array retu rned if se lections m ade
	1998	; IBDA (n)=ien of bill sele cted (file 399)
	1999	; ONE = i f set to 1 , only one selection can be ma de at a ti me
	2000	N IB
	2001	K IBDA
	2002	D FULL^VA LM1
	2003	D EN^VALM 2($G(XQORN OD(0)),$S( '$G(ONE):" ",1:"S"))
	2004	S IBDA=0 F S IBDA= $O(VALMY(I BDA)) Q:'I BDA S IBD A(IBDA)=$P ($G(^TMP(" IBCECOB",$ J,+IBDA)), U,2,6)
	2005	Q
	2006	;
	2007	EXIT ; Exi t out of C OB
	2008	D FASTEXI T^IBCEFG4
	2009	I $G(IBFA STXT)=1 S IBFASTXT=5
	2010	Q
	2011	;
	2012	TOT(IBIFN, IBMRANOT) ; calculat e if any b alance rem aining on non-MRA cl aim
	2013	; IBIFN = claim ien
	2014	; IBMRANO T = MRW/CB W flag (1= user came from CBW) added wit h IB2.04 47
	2015	N IBPRTOT ,IBBLD,IBC BN,IBU2
	2016	I $G(IBMR ANOT)'=1 Q $S($$MSED T^IBCEMU4( IBIFN)'="" :$$MSPRE^I BCEMU4(IBI FN),1:$$PR EOBTOT^IBC EU0(IBIFN) )
	2017	; total u p the paye r paid amo unts, if t his is a 2 ndary clai m, be sure to accoun t for what the prima ry paid al so
	2018	S IBU2=$G (^DGCR(399 ,IBIFN,"U2 ")),IBCBN= $$COBN^IBC EF(IBIFN), IBPRTOT=$$ EOBTOT^IBC EU1(IBIFN, IBCBN)
	2019	S:IBPRTOT <0 IBPRTOT =0 ; don't allo w negative prior pay ment or of fset
	2020	S:IBCBN=2 IBPRTOT=I BPRTOT+$P( IBU2,U,4)
	2021	S:IBCBN=3 IBPRTOT=I BPRTOT+$P( IBU2,U,4)+ $P(IBU2,U, 5)
	2022	S:IBPRTOT <0 IBPRTOT =0 ; don't allo w negative prior pay ment or of fset
	2023	; Subtrac t payer pa id amount from Total Charges f rom BILLS/ CLAIMS (#3 99) file, don't allo w neg
	2024	S IBBLD=$ P($G(^DGCR (399,IBIFN ,"U1")),U, 1)-IBPRTOT
	2025	S:IBBLD<0 IBBLD=0
	2026	Q IBBLD
	2027	;
	2028	CCCHK(IBIF N) ; If th ere are mu ltiple EOB S on file for this c laim, then one of th em must be processed and AR st atus must be collect ed closed to process .
	2029	; returns 1 if true
	2030	; 0 if ther e are not multiple E OBs or mul itple EOBs and none are proces sed (all d enials)
	2031	; -1 if fals e
	2032	N IBDA,IB CT,IBPROC, IBARSTAT,I BEOBNDX,IB EOB
	2033	S IBCT=0, IBPROC=0
	2034	F IBEOBND X="B","C" D
	2035	.S IBDA=0 F S IBDA =$O(^IBM(3 61.1,IBEOB NDX,IBIFN, IBDA)) Q:' +IBDA D
	2036	..Q:$D(IB EOB(IBDA))
	2037	..Q:$P($G (^IBM(361. 1,IBDA,0)) ,U,4)=1 ; only co unt EOBs
	2038	..S IBEOB (IBDA)="", IBCT=IBCT+ 1
	2039	..I $P($G (^IBM(361. 1,IBDA,0)) ,U,13)=1 S IBPROC=1
	2040	I IBCT<2 Q 0 ; les s than 2 E OBs
	2041	I 'IBPROC Q 0 ; no EOBs with status pr ocessed
	2042	S IBARSTA T=$$ARSTAT A^IBJTU4(I BIFN) ; g et status of AR
	2043	I $P(IBAR STAT,U)="C OLLECTED/C LOSED" Q 1
	2044	Q -1
	2045	;
	2046	DENCHK(IBI FN,IBCT) ; Make sure all EOBs from this claim are denied.
	2047	; Input: IBIFN - IE N to 399
	2048	; IBCT - by reference. Return co unt of EOB s.
	2049	; Output: returns 1 if there is at leas t one EOB and that n one of the EOBS are processed.
	2050	; otherwi se 0
	2051	;
	2052	N IBDA,IB PROC,IBEOB NDX,IBEOB
	2053	S IBCT=0, IBPROC=0
	2054	F IBEOBND X="B","C" D
	2055	.S IBDA=0 F S IBDA =$O(^IBM(3 61.1,IBEOB NDX,IBIFN, IBDA)) Q:' +IBDA D
	2056	..Q:$D(IB EOB(IBDA))
	2057	..Q:$P($G (^IBM(361. 1,IBDA,0)) ,U,4)=1 ; only co unt EOBs
	2058	..S IBEOB (IBDA)="", IBCT=IBCT+ 1
	2059	..I $P($G (^IBM(361. 1,IBDA,0)) ,U,13)=1 S IBPROC=1
	2060	I IBCT,'I BPROC Q 1 ; there i s at least one EOB a nd none of the EOBS are proces sed.
	2061	Q 0 ;
	2062	;
	2063	WARNMSE() ; Display MSE Warnin g and chec k if we sh ould conti nue.
	2064	D FULL^VA LM1
	2065	N DIR,X,Y
	2066	S DIR("A" ,1)="WARNI NG : The M RA for thi s claim ca used a Dat a Mismatch /Message S torage Err or."
	2067	S DIR("A" ,2)="If yo u continue , the seco ndary clai m may not contain th e correct data."
	2068	S DIR("A" )="Do you wish to co ntinue? ", DIR("B")=" NO",DIR(0) ="YA" D ^D IR
	2069	I Y>0 Q 1 ; Okay to continu e.
	2070	Q 0 ;