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

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