[628] | 1 | IBJTCA2 ;ALB/ARH - TPI CLAIMS INFO BUILD (CONT) ;16-FEB-1995
|
---|
| 2 | ;;2.0;INTEGRATED BILLING;**39,80,155,320**;21-MAR-94
|
---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
| 4 | ;
|
---|
| 5 | CONT ; Continuation of Claim Information Screen Build
|
---|
| 6 | ; reason cancelled
|
---|
| 7 | I $P(IBD0,U,13)=7 D
|
---|
| 8 | . 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
|
---|
| 9 | . S (IBT,IBD)="" S IBLN=$$SET(IBT,IBD,IBLN,1)
|
---|
| 10 | . ;
|
---|
| 11 | . S IBGRPB=IBLN,IBLR=1
|
---|
| 12 | . K IBY D RCANC^IBJTU2(IBIFN,.IBY,50)
|
---|
| 13 | . S IBT="Reason Cancelled by ("_$P(IBY,U,3)_"): "
|
---|
| 14 | . S IBI=0 F S IBI=$O(IBY(IBI)) Q:'IBI S IBD=IBY(IBI) S IBLN=$$SET(IBT,IBD,IBLN,IBLR),IBT=""
|
---|
| 15 | ;
|
---|
| 16 | S (IBLN,VALMCNT)=$S(IBLN>IBGRPE:IBLN,1:IBGRPE)
|
---|
| 17 | S (IBNC(1),IBTC(1))=2,IBTW(1)=16,IBSW(1)=50
|
---|
| 18 | S (IBT,IBD)="" S IBLN=$$SET(IBT,IBD,IBLN,IBLR)
|
---|
| 19 | ;
|
---|
| 20 | S IBGRPB=IBLN,IBLR=1
|
---|
| 21 | ;
|
---|
| 22 | I +$P(IBDS,U,1) S IBT="Entered: ",IBD=$$EXT(IBDS,1,2) S IBLN=$$SET(IBT,IBD,IBLN,IBLR)
|
---|
| 23 | I +$P(IBDS,U,4) S IBT="Initial Review: ",IBD=$$EXT(IBDS,4,5) S IBLN=$$SET(IBT,IBD,IBLN,IBLR)
|
---|
| 24 | I +$P(IBDS,U,7) S IBT="MRA Request: ",IBD=$$EXT(IBDS,7,8) S IBLN=$$SET(IBT,IBD,IBLN,IBLR)
|
---|
| 25 | I +$P(IBDS,U,10) S IBT="Authorized: ",IBD=$$EXT(IBDS,10,11) S IBLN=$$SET(IBT,IBD,IBLN,IBLR)
|
---|
| 26 | I +$P(IBDS,U,12) S IBT="First Printed: ",IBD=$$EXT(IBDS,12,13) S IBLN=$$SET(IBT,IBD,IBLN,IBLR)
|
---|
| 27 | 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)
|
---|
| 28 | I +$P(IBDS,U,17) S IBT="Cancelled: ",IBD=$$EXT(IBDS,17,18) S IBLN=$$SET(IBT,IBD,IBLN,IBLR)
|
---|
| 29 | ;
|
---|
| 30 | ; Patch 320 - added bill cloning history to TPJI report.
|
---|
| 31 | N IBCCR,IBCURR,IBNEXT,IBBCH,IBINDENT
|
---|
| 32 | S IBINDENT=0
|
---|
| 33 | D EN^IBCCR(IBIFN,.IBCCR) ; utility to pull cloning history
|
---|
| 34 | ;
|
---|
| 35 | ; attempt to go one claim forward from the current claim
|
---|
| 36 | S IBCURR="IBCCR("_+$P(IBDS,U,1)_","_IBIFN_")"
|
---|
| 37 | S IBNEXT=$Q(@IBCURR)
|
---|
| 38 | I IBNEXT'="" D
|
---|
| 39 | . N IBX S IBX=@IBNEXT
|
---|
| 40 | . S IBT="Copied: "
|
---|
| 41 | . S IBD=$$FMTE^XLFDT($P(IBX,U,1),"2Z")_" by "_$P(IBX,U,3)
|
---|
| 42 | . S IBLN=$$SET(IBT,IBD,IBLN,IBLR)
|
---|
| 43 | . S IBT="Copied To: ",IBD=$P(IBX,U,2),IBLN=$$SET(IBT,IBD,IBLN,IBLR)
|
---|
| 44 | . S IBINDENT=1
|
---|
| 45 | . Q
|
---|
| 46 | ;
|
---|
| 47 | ; now go backwards for claim cloning history all the way back
|
---|
| 48 | S IBBCH=IBCURR
|
---|
| 49 | F S IBBCH=$Q(@IBBCH,-1) Q:IBBCH="" D
|
---|
| 50 | . N IBX S IBX=@IBBCH
|
---|
| 51 | . S IBT="Copied: " I IBINDENT S IBT=" "_IBT
|
---|
| 52 | . S IBD=$$FMTE^XLFDT($P(IBX,U,1),"2Z")_" by "_$P(IBX,U,3)
|
---|
| 53 | . S IBLN=$$SET(IBT,IBD,IBLN,IBLR)
|
---|
| 54 | . S IBT="Copied From: " I IBINDENT S IBT=" "_IBT
|
---|
| 55 | . S IBD=$P(IBX,U,2),IBLN=$$SET(IBT,IBD,IBLN,IBLR)
|
---|
| 56 | . S IBT="Reason Copied: " I IBINDENT S IBT=" "_IBT
|
---|
| 57 | . S IBD=$P(IBX,U,4),IBLN=$$SET(IBT,IBD,IBLN,IBLR)
|
---|
| 58 | . S IBINDENT=1
|
---|
| 59 | . Q
|
---|
| 60 | ;
|
---|
| 61 | 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
|
---|
| 62 | . S IBY=$G(^DGCR(399,IBIFN,"R",X,0)),IBD=$$EXT(IBY,1,2) S IBLN=$$SET(IBT,IBD,IBLN,IBLR)
|
---|
| 63 | ;
|
---|
| 64 | N IBCOB,IBX,IBY,IBI,IBJ,IBK D BCOB^IBCU3(IBIFN,.IBCOB) I $O(IBCOB(0)) D
|
---|
| 65 | . S IBTC(1)=2,IBTW(1)=12,IBSW(1)=68,IBLR=1,IBNC(1)=26
|
---|
| 66 | . S (IBT,IBD)="" S IBLN=$$SET(IBT,IBD,IBLN,1)
|
---|
| 67 | . S IBT="Payers and Related Bills" S IBLN=$$SETN^IBJTCA1(IBT,IBLN,IBLR,1)
|
---|
| 68 | . S (IBT,IBD)="" S IBLN=$$SET(IBT,IBD,IBLN,1)
|
---|
| 69 | . S IBT="",IBD="Insurance Co. Bill # Status Original Collected Balance"
|
---|
| 70 | . S IBLN=$$SET(IBT,IBD,IBLN,IBLR) D CNTRL^VALM10(IBLN-1,(IBTC(1)+IBTW(1)),IBSW(1),IOUON,IOUOFF)
|
---|
| 71 | . S IBI=0 F S IBI=$O(IBCOB(IBI)) Q:'IBI D
|
---|
| 72 | .. S IBT=$S(IBI=1:"Primary",IBI=2:"Secondary",IBI=3:"Tertiary",1:"Other")_": "
|
---|
| 73 | .. 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
|
---|
| 74 | ... S IBD="",IBY=$$BILL^RCJIBFN2(IBK)
|
---|
| 75 | ... S IBX=$P($G(^DIC(36,+IBJ,0)),U,1) S IBD=$$SLINE(IBD,IBX,0,15)
|
---|
| 76 | ... I +IBK D
|
---|
| 77 | .... S IBX=$P($G(^DGCR(399,+IBK,0)),U,1) S IBD=$$SLINE(IBD,IBX,17,10)
|
---|
| 78 | .... S IBX=$P($$STNO^RCJIBFN2(+$P(IBY,U,2)),U,2) ;bill status
|
---|
| 79 | .... ; if MRA active & bill pyr seq >1 & dsply'g prmry & prmry ins is WNR
|
---|
| 80 | .... I $$EDIACTV^IBCEF4(2),$$COBN^IBCEF(+IBK)>1,IBI=1,$$MCRWNR^IBEFUNC(+IBJ) D
|
---|
| 81 | ..... S IBX=" ",IBY="0^^0^0^0" ;blank out status & reset WNR amounts
|
---|
| 82 | .... S IBD=$$SLINE(IBD,IBX,30,3)
|
---|
| 83 | .... S IBX=$J($P(IBY,U,1),10,2) S IBD=$$SLINE(IBD,IBX,35,10)
|
---|
| 84 | .... S IBX=$J($P(IBY,U,4),10,2) S IBD=$$SLINE(IBD,IBX,46,10)
|
---|
| 85 | .... S IBX=$J($P(IBY,U,3),10,2) S IBD=$$SLINE(IBD,IBX,57,10)
|
---|
| 86 | ... S IBLN=$$SET(IBT,IBD,IBLN,IBLR),IBT=""
|
---|
| 87 | Q
|
---|
| 88 | ;
|
---|
| 89 | EXT(STR,DT,USER) ; returns external form of user and date, given their position in the string
|
---|
| 90 | N X,Y S Y="",STR=$G(STR),DT=+$G(DT),USER=+$G(USER)
|
---|
| 91 | S X=$P(STR,U,DT),DT="" I +X S DT=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)
|
---|
| 92 | S X=$P(STR,U,USER),USER="" I +X S USER=$P($G(^VA(200,+X,0)),U,1)
|
---|
| 93 | S Y=DT_" by "_$S(USER="":"UNKNOWN",1:USER)
|
---|
| 94 | Q Y
|
---|
| 95 | ;
|
---|
| 96 | SET(IBT,IBD,IBLN,IBLR) ;
|
---|
| 97 | N LN S LN=$$SET^IBJTCA1(IBT,IBD,IBLN,IBLR)
|
---|
| 98 | Q LN
|
---|
| 99 | ;
|
---|
| 100 | SLINE(IBD,DATA,COL,WD) ; format a single line with multiple data fields
|
---|
| 101 | S IBD=$E(IBD,1,(COL-1)),IBD=IBD_$J("",(COL-$L(IBD))),IBD=IBD_$E(DATA,1,WD)
|
---|
| 102 | Q IBD
|
---|