IBJTCA2	;ALB/ARH - TPI CLAIMS INFO BUILD (CONT) ;7:39 PM  30 Jan 2008
	;;2.0;INTEGRATED BILLING;**39,80,155,320,VWEHR1**;WorldVistA 30-Jan-08;Build 4
	;;Per VHA Directive 10-93-142, this routine should not be modified.
	;
	;Modified from FOIA VISTA,
	;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
	;General Public License See attached copy of the License.
	;
	;This program is free software; you can redistribute it and/or modify
	;it under the terms of the GNU General Public License as published by
	;the Free Software Foundation; either version 2 of the License, or
	;(at your option) any later version.
	;
	;This program is distributed in the hope that it will be useful,
	;but WITHOUT ANY WARRANTY; without even the implied warranty of
	;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
	;GNU General Public License for more details.
	;
	;You should have received a copy of the GNU General Public License along
	;with this program; if not, write to the Free Software Foundation, Inc.,
	;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
	;
CONT	; Continuation of Claim Information Screen Build
	; reason cancelled
	I $P(IBD0,U,13)=7 D
	. S (IBNC(1),IBTC(1))=2,(IBNC(2),IBTC(2))=0,IBNC(3)=28,IBTW(1)=29,IBTW(2)=0,IBSW(1)=49,IBSW(2)=0
	. S (IBT,IBD)="" S IBLN=$$SET(IBT,IBD,IBLN,1)
	. ;
	. S IBGRPB=IBLN,IBLR=1
	. K IBY D RCANC^IBJTU2(IBIFN,.IBY,50)
	. S IBT="Reason Cancelled by ("_$P(IBY,U,3)_"): "
	. S IBI=0 F  S IBI=$O(IBY(IBI)) Q:'IBI  S IBD=IBY(IBI) S IBLN=$$SET(IBT,IBD,IBLN,IBLR),IBT=""
	;
	S (IBLN,VALMCNT)=$S(IBLN>IBGRPE:IBLN,1:IBGRPE)
	S (IBNC(1),IBTC(1))=2,IBTW(1)=16,IBSW(1)=50
	S (IBT,IBD)="" S IBLN=$$SET(IBT,IBD,IBLN,IBLR)
	;
	S IBGRPB=IBLN,IBLR=1
	;
	I +$P(IBDS,U,1) S IBT="Entered: ",IBD=$$EXT(IBDS,1,2) S IBLN=$$SET(IBT,IBD,IBLN,IBLR)
	I +$P(IBDS,U,4) S IBT="Initial Review: ",IBD=$$EXT(IBDS,4,5) S IBLN=$$SET(IBT,IBD,IBLN,IBLR)
	I +$P(IBDS,U,7) S IBT="MRA Request: ",IBD=$$EXT(IBDS,7,8) S IBLN=$$SET(IBT,IBD,IBLN,IBLR)
	I +$P(IBDS,U,10) S IBT="Authorized: ",IBD=$$EXT(IBDS,10,11) S IBLN=$$SET(IBT,IBD,IBLN,IBLR)
	I +$P(IBDS,U,12) S IBT="First Printed: ",IBD=$$EXT(IBDS,12,13) S IBLN=$$SET(IBT,IBD,IBLN,IBLR)
	I $P(IBDS,U,14)>$P(IBDS,U,12) S IBT="Last Printed: ",IBD=$$EXT(IBDS,14,15) S IBLN=$$SET(IBT,IBD,IBLN,IBLR)
	I +$P(IBDS,U,17) S IBT="Cancelled: ",IBD=$$EXT(IBDS,17,18) S IBLN=$$SET(IBT,IBD,IBLN,IBLR)
	;
	; Patch 320 - added bill cloning history to TPJI report.
	N IBCCR,IBCURR,IBNEXT,IBBCH,IBINDENT
	S IBINDENT=0
	D EN^IBCCR(IBIFN,.IBCCR)   ; utility to pull cloning history
	;
	; attempt to go one claim forward from the current claim
	S IBCURR="IBCCR("_+$P(IBDS,U,1)_","_IBIFN_")"
	S IBNEXT=$Q(@IBCURR)
	I IBNEXT'="" D
	. N IBX S IBX=@IBNEXT
	. S IBT="Copied: "
	. S IBD=$$FMTE^XLFDT($P(IBX,U,1),"2Z")_"  by  "_$P(IBX,U,3)
	. S IBLN=$$SET(IBT,IBD,IBLN,IBLR)
	. S IBT="Copied To: ",IBD=$P(IBX,U,2),IBLN=$$SET(IBT,IBD,IBLN,IBLR)
	. S IBINDENT=1
	. Q
	;
	; now go backwards for claim cloning history all the way back
	S IBBCH=IBCURR
	;
	;WV/EHR REVERSE $Q REPLACEMENT; SO 01/12/08 ;VWEHR1
	;
	;F  S IBBCH=$Q(@IBBCH,-1) Q:IBBCH=""  D
	F  S IBBCH=$$Q^VWUTIL($NA(@IBBCH),-1) Q:IBBCH=""  D
	. ;
	. ;END CHANGE
	. ;
	. N IBX S IBX=@IBBCH
	. S IBT="Copied: " I IBINDENT S IBT="                  "_IBT
	. S IBD=$$FMTE^XLFDT($P(IBX,U,1),"2Z")_"  by  "_$P(IBX,U,3)
	. S IBLN=$$SET(IBT,IBD,IBLN,IBLR)
	. S IBT="Copied From: " I IBINDENT S IBT="             "_IBT
	. S IBD=$P(IBX,U,2),IBLN=$$SET(IBT,IBD,IBLN,IBLR)
	. S IBT="Reason Copied: " I IBINDENT S IBT="           "_IBT
	. S IBD=$P(IBX,U,4),IBLN=$$SET(IBT,IBD,IBLN,IBLR)
	. S IBINDENT=1
	. Q
	;
	I $D(^DGCR(399,IBIFN,"R","AC",1)) S IBT="Returned to AR: ",X=0 F  S X=$O(^DGCR(399,IBIFN,"R","AC",1,X)) Q:'X  D
	. S IBY=$G(^DGCR(399,IBIFN,"R",X,0)),IBD=$$EXT(IBY,1,2) S IBLN=$$SET(IBT,IBD,IBLN,IBLR)
	;
	N IBCOB,IBX,IBY,IBI,IBJ,IBK D BCOB^IBCU3(IBIFN,.IBCOB) I $O(IBCOB(0)) D
	. S IBTC(1)=2,IBTW(1)=12,IBSW(1)=68,IBLR=1,IBNC(1)=26
	. S (IBT,IBD)="" S IBLN=$$SET(IBT,IBD,IBLN,1)
	. S IBT="Payers and Related Bills" S IBLN=$$SETN^IBJTCA1(IBT,IBLN,IBLR,1)
	. S (IBT,IBD)="" S IBLN=$$SET(IBT,IBD,IBLN,1)
	. S IBT="",IBD="Insurance Co.    Bill #     Status   Original  Collected    Balance"
	. S IBLN=$$SET(IBT,IBD,IBLN,IBLR) D CNTRL^VALM10(IBLN-1,(IBTC(1)+IBTW(1)),IBSW(1),IOUON,IOUOFF)
	. S IBI=0 F  S IBI=$O(IBCOB(IBI)) Q:'IBI  D
	.. S IBT=$S(IBI=1:"Primary",IBI=2:"Secondary",IBI=3:"Tertiary",1:"Other")_":  "
	.. S IBJ=0 F  S IBJ=$O(IBCOB(IBI,IBJ)) Q:'IBJ  S IBK="" F  S IBK=$O(IBCOB(IBI,IBJ,IBK)) Q:IBK=""  D
	... S IBD="",IBY=$$BILL^RCJIBFN2(IBK)
	... S IBX=$P($G(^DIC(36,+IBJ,0)),U,1) S IBD=$$SLINE(IBD,IBX,0,15)
	... I +IBK D
	.... S IBX=$P($G(^DGCR(399,+IBK,0)),U,1) S IBD=$$SLINE(IBD,IBX,17,10)
	.... S IBX=$P($$STNO^RCJIBFN2(+$P(IBY,U,2)),U,2) ;bill status
	.... ; if MRA active & bill pyr seq >1 & dsply'g prmry & prmry ins is WNR
	.... I $$EDIACTV^IBCEF4(2),$$COBN^IBCEF(+IBK)>1,IBI=1,$$MCRWNR^IBEFUNC(+IBJ) D
	..... S IBX=" ",IBY="0^^0^0^0" ;blank out status & reset WNR amounts
	.... S IBD=$$SLINE(IBD,IBX,30,3)
	.... S IBX=$J($P(IBY,U,1),10,2) S IBD=$$SLINE(IBD,IBX,35,10)
	.... S IBX=$J($P(IBY,U,4),10,2) S IBD=$$SLINE(IBD,IBX,46,10)
	.... S IBX=$J($P(IBY,U,3),10,2) S IBD=$$SLINE(IBD,IBX,57,10)
	... S IBLN=$$SET(IBT,IBD,IBLN,IBLR),IBT=""
	Q
	;
EXT(STR,DT,USER)	; returns external form of user and date, given their position in the string
	N X,Y S Y="",STR=$G(STR),DT=+$G(DT),USER=+$G(USER)
	S X=$P(STR,U,DT),DT="" I +X S DT=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)
	S X=$P(STR,U,USER),USER="" I +X S USER=$P($G(^VA(200,+X,0)),U,1)
	S Y=DT_"  by  "_$S(USER="":"UNKNOWN",1:USER)
	Q Y
	;
SET(IBT,IBD,IBLN,IBLR)	;
	N LN S LN=$$SET^IBJTCA1(IBT,IBD,IBLN,IBLR)
	Q LN
	;
SLINE(IBD,DATA,COL,WD)	; format a single line with multiple data fields
	S IBD=$E(IBD,1,(COL-1)),IBD=IBD_$J("",(COL-$L(IBD))),IBD=IBD_$E(DATA,1,WD)
	Q IBD