IBJTCA2 ;ALB/ARH - TPI CLAIMS INFO BUILD (CONT) ;16-FEB-1995
;;2.0;INTEGRATED BILLING;**39,80,155,320,516**;21-MAR-94;Build 123
;;Per VA Directive 6402, this routine should not be modified.
;
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
F S IBBCH=$Q(@IBBCH,-1) Q:IBBCH="" D
. 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,IBTW(0)=0
. 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 IBTC(1)=0,IBTW(1)=0,IBSW(1)=68,IBLR=1,IBNC(1)=0
. 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=""
;
;IB*2.0*516 - Display links from 3rd party bill to 1st party bill(s)
K ^TMP("IBRBF",$J)
D RELBILL^IBRFN(IBIFN)
N IBCIFN,IBCNT
S IBCNT=0,IBCIFN="" F S IBCIFN=$O(^TMP("IBRBF",$J,IBIFN,IBCIFN)) Q:IBCIFN="" D
. I $P(^(IBCIFN),"^",6)["RX COPAY" K ^TMP("IBRBF",$J,IBIFN,IBCIFN) Q
. S IBCNT=IBCNT+1
D HDR2
I IBCNT=0 S (IBT,IBD)="",IBX="No Links to 1st Party Bills Found",IBD=$$SLINE(IBD,IBX,0,35),IBLN=$$SET(IBT,IBD,IBLN,IBLR) Q
S (IBD,IBX,IBT)=""
S IBCIFN="" F S IBCIFN=$O(^TMP("IBRBF",$J,IBIFN,IBCIFN)) Q:IBCIFN="" D PRINT2
K ^TMP("IBRBF",$J)
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
;
HDR2 ;Print the header for first party bills - IB*2*516
S (IBT,IBD)="",IBLR=1,IBNC(1)=26
S IBLN=$$SET(IBT,IBD,IBLN,1)
S IBT="Related First Party Charges" S IBLN=$$SETN^IBJTCA1(IBT,IBLN,IBLR,1)
S (IBT,IBD)="" S IBLN=$$SET(IBT,IBD,IBLN,1)
S IBTC(1)=0,IBTW(1)=1,IBSW(1)=80,IBLR=1,IBNC(1)=26
S IBT="Bill# Charge Type Status Amt Billed On Hold Balance"
S IBLN=$$SET(IBT,IBD,IBLN,IBLR) D CNTRL^VALM10(IBLN-1,(IBTC(1)+IBTW(1)),IBSW(1),IOUON,IOUOFF)
Q
;
PRINT2 ;Print the detail line for a first party bill - IB*2*516
S IBTC(1)=0,IBTW(1)=0,IBSW(1)=80,IBLR=1
S IBDAT=$G(^TMP("IBRBF",$J,IBIFN,IBCIFN)),IBD=""
S IBX=$P(IBDAT,"^",4) S:IBX="" IBX="Not Assigned" S IBD=$$SLINE(IBD,IBX,0,13)
S IBX=$P(IBDAT,"^",6),IBD=$$SLINE(IBD,IBX,14,12)
S IBX=$$GET1^DIQ(350,IBCIFN_",",.05) S:IBX="" IBX="Incomplete" S IBD=$$SLINE(IBD,IBX,27,11)
S IBFN=$P(IBDAT,"^",4) I IBFN S IBFN=$O(^PRCA(430,"B",IBFN,0))
S IBX=$J($P(IBDAT,"^",5),9,2),IBD=$$SLINE(IBD,IBX,40,10)
S IBX=$P(IBDAT,"^",7),IBD=$$SLINE(IBD,IBX,53,10)
S IBX=$J($S($G(^PRCA(430,+IBFN,7)):+($P(^(7),"^")+$P(^(7),"^",2)+$P(^(7),"^",3)+$P(^(7),"^",4)+$P(^(7),"^",4)),1:0),9,2),IBD=$$SLINE(IBD,IBX,63,10)
S IBLN=$$SET(IBT,IBD,IBLN,1)
Q
;
STAT(RCIBFN) ;AR Status
I '$G(RCIBFN) Q ""
N RCSTAT
S RCSTAT=$P($G(^PRCA(430,+RCIBFN,0)),"^",8),RCSTAT=$P($G(^PRCA(430.3,+RCSTAT,0)),"^",2)
Q RCSTAT
;
DATE(X) ; Convert FileMan date to mm/dd/yy
Q $S($G(X):$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3),1:"")
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBJTCA2 7057 printed Dec 13, 2024@02:23:52 Page 2
IBJTCA2 ;ALB/ARH - TPI CLAIMS INFO BUILD (CONT) ;16-FEB-1995
+1 ;;2.0;INTEGRATED BILLING;**39,80,155,320,516**;21-MAR-94;Build 123
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
CONT ; Continuation of Claim Information Screen Build
+1 ; reason cancelled
+2 IF $PIECE(IBD0,U,13)=7
Begin DoDot:1
+3 SET (IBNC(1),IBTC(1))=2
SET (IBNC(2),IBTC(2))=0
SET IBNC(3)=28
SET IBTW(1)=29
SET IBTW(2)=0
SET IBSW(1)=49
SET IBSW(2)=0
+4 SET (IBT,IBD)=""
SET IBLN=$$SET(IBT,IBD,IBLN,1)
+5 ;
+6 SET IBGRPB=IBLN
SET IBLR=1
+7 KILL IBY
DO RCANC^IBJTU2(IBIFN,.IBY,50)
+8 SET IBT="Reason Cancelled by ("_$PIECE(IBY,U,3)_"): "
+9 SET IBI=0
FOR
SET IBI=$ORDER(IBY(IBI))
if 'IBI
QUIT
SET IBD=IBY(IBI)
SET IBLN=$$SET(IBT,IBD,IBLN,IBLR)
SET IBT=""
End DoDot:1
+10 ;
+11 SET (IBLN,VALMCNT)=$SELECT(IBLN>IBGRPE:IBLN,1:IBGRPE)
+12 SET (IBNC(1),IBTC(1))=2
SET IBTW(1)=16
SET IBSW(1)=50
+13 SET (IBT,IBD)=""
SET IBLN=$$SET(IBT,IBD,IBLN,IBLR)
+14 ;
+15 SET IBGRPB=IBLN
SET IBLR=1
+16 ;
+17 IF +$PIECE(IBDS,U,1)
SET IBT="Entered: "
SET IBD=$$EXT(IBDS,1,2)
SET IBLN=$$SET(IBT,IBD,IBLN,IBLR)
+18 IF +$PIECE(IBDS,U,4)
SET IBT="Initial Review: "
SET IBD=$$EXT(IBDS,4,5)
SET IBLN=$$SET(IBT,IBD,IBLN,IBLR)
+19 IF +$PIECE(IBDS,U,7)
SET IBT="MRA Request: "
SET IBD=$$EXT(IBDS,7,8)
SET IBLN=$$SET(IBT,IBD,IBLN,IBLR)
+20 IF +$PIECE(IBDS,U,10)
SET IBT="Authorized: "
SET IBD=$$EXT(IBDS,10,11)
SET IBLN=$$SET(IBT,IBD,IBLN,IBLR)
+21 IF +$PIECE(IBDS,U,12)
SET IBT="First Printed: "
SET IBD=$$EXT(IBDS,12,13)
SET IBLN=$$SET(IBT,IBD,IBLN,IBLR)
+22 IF $PIECE(IBDS,U,14)>$PIECE(IBDS,U,12)
SET IBT="Last Printed: "
SET IBD=$$EXT(IBDS,14,15)
SET IBLN=$$SET(IBT,IBD,IBLN,IBLR)
+23 IF +$PIECE(IBDS,U,17)
SET IBT="Cancelled: "
SET IBD=$$EXT(IBDS,17,18)
SET IBLN=$$SET(IBT,IBD,IBLN,IBLR)
+24 ;
+25 ; Patch 320 - added bill cloning history to TPJI report.
+26 NEW IBCCR,IBCURR,IBNEXT,IBBCH,IBINDENT
+27 SET IBINDENT=0
+28 ; utility to pull cloning history
DO EN^IBCCR(IBIFN,.IBCCR)
+29 ;
+30 ; attempt to go one claim forward from the current claim
+31 SET IBCURR="IBCCR("_+$PIECE(IBDS,U,1)_","_IBIFN_")"
+32 SET IBNEXT=$QUERY(@IBCURR)
+33 IF IBNEXT'=""
Begin DoDot:1
+34 NEW IBX
SET IBX=@IBNEXT
+35 SET IBT="Copied: "
+36 SET IBD=$$FMTE^XLFDT($PIECE(IBX,U,1),"2Z")_" by "_$PIECE(IBX,U,3)
+37 SET IBLN=$$SET(IBT,IBD,IBLN,IBLR)
+38 SET IBT="Copied To: "
SET IBD=$PIECE(IBX,U,2)
SET IBLN=$$SET(IBT,IBD,IBLN,IBLR)
+39 SET IBINDENT=1
+40 QUIT
End DoDot:1
+41 ;
+42 ; now go backwards for claim cloning history all the way back
+43 SET IBBCH=IBCURR
+44 FOR
SET IBBCH=$QUERY(@IBBCH,-1)
if IBBCH=""
QUIT
Begin DoDot:1
+45 NEW IBX
SET IBX=@IBBCH
+46 SET IBT="Copied: "
IF IBINDENT
SET IBT=" "_IBT
+47 SET IBD=$$FMTE^XLFDT($PIECE(IBX,U,1),"2Z")_" by "_$PIECE(IBX,U,3)
+48 SET IBLN=$$SET(IBT,IBD,IBLN,IBLR)
+49 SET IBT="Copied From: "
IF IBINDENT
SET IBT=" "_IBT
+50 SET IBD=$PIECE(IBX,U,2)
SET IBLN=$$SET(IBT,IBD,IBLN,IBLR)
+51 SET IBT="Reason Copied: "
IF IBINDENT
SET IBT=" "_IBT
+52 SET IBD=$PIECE(IBX,U,4)
SET IBLN=$$SET(IBT,IBD,IBLN,IBLR)
+53 SET IBINDENT=1
+54 QUIT
End DoDot:1
+55 ;
+56 IF $DATA(^DGCR(399,IBIFN,"R","AC",1))
SET IBT="Returned to AR: "
SET X=0
FOR
SET X=$ORDER(^DGCR(399,IBIFN,"R","AC",1,X))
if 'X
QUIT
Begin DoDot:1
+57 SET IBY=$GET(^DGCR(399,IBIFN,"R",X,0))
SET IBD=$$EXT(IBY,1,2)
SET IBLN=$$SET(IBT,IBD,IBLN,IBLR)
End DoDot:1
+58 ;
+59 NEW IBCOB,IBX,IBY,IBI,IBJ,IBK
DO BCOB^IBCU3(IBIFN,.IBCOB)
IF $ORDER(IBCOB(0))
Begin DoDot:1
+60 SET IBTC(1)=2
SET IBTW(1)=12
SET IBSW(1)=68
SET IBLR=1
SET IBNC(1)=26
SET IBTW(0)=0
+61 SET (IBT,IBD)=""
SET IBLN=$$SET(IBT,IBD,IBLN,1)
+62 SET IBT="Payers and Related Bills"
SET IBLN=$$SETN^IBJTCA1(IBT,IBLN,IBLR,1)
+63 SET (IBT,IBD)=""
SET IBLN=$$SET(IBT,IBD,IBLN,1)
+64 SET IBTC(1)=0
SET IBTW(1)=0
SET IBSW(1)=68
SET IBLR=1
SET IBNC(1)=0
+65 SET IBT=""
SET IBD="Insurance Co. Bill # Status Original Collected Balance"
+66 SET IBLN=$$SET(IBT,IBD,IBLN,IBLR)
DO CNTRL^VALM10(IBLN-1,(IBTC(1)+IBTW(1)),IBSW(1),IOUON,IOUOFF)
+67 SET IBI=0
FOR
SET IBI=$ORDER(IBCOB(IBI))
if 'IBI
QUIT
Begin DoDot:2
+68 SET IBT=$SELECT(IBI=1:"Primary",IBI=2:"Secondary",IBI=3:"Tertiary",1:"Other")_": "
+69 SET IBJ=0
FOR
SET IBJ=$ORDER(IBCOB(IBI,IBJ))
if 'IBJ
QUIT
SET IBK=""
FOR
SET IBK=$ORDER(IBCOB(IBI,IBJ,IBK))
if IBK=""
QUIT
Begin DoDot:3
+70 SET IBD=""
SET IBY=$$BILL^RCJIBFN2(IBK)
+71 SET IBX=$PIECE($GET(^DIC(36,+IBJ,0)),U,1)
SET IBD=$$SLINE(IBD,IBX,0,15)
+72 IF +IBK
Begin DoDot:4
+73 SET IBX=$PIECE($GET(^DGCR(399,+IBK,0)),U,1)
SET IBD=$$SLINE(IBD,IBX,17,10)
+74 ;bill status
SET IBX=$PIECE($$STNO^RCJIBFN2(+$PIECE(IBY,U,2)),U,2)
+75 ; if MRA active & bill pyr seq >1 & dsply'g prmry & prmry ins is WNR
+76 IF $$EDIACTV^IBCEF4(2)
IF $$COBN^IBCEF(+IBK)>1
IF IBI=1
IF $$MCRWNR^IBEFUNC(+IBJ)
Begin DoDot:5
+77 ;blank out status & reset WNR amounts
SET IBX=" "
SET IBY="0^^0^0^0"
End DoDot:5
+78 SET IBD=$$SLINE(IBD,IBX,30,3)
+79 SET IBX=$JUSTIFY($PIECE(IBY,U,1),10,2)
SET IBD=$$SLINE(IBD,IBX,35,10)
+80 SET IBX=$JUSTIFY($PIECE(IBY,U,4),10,2)
SET IBD=$$SLINE(IBD,IBX,46,10)
+81 SET IBX=$JUSTIFY($PIECE(IBY,U,3),10,2)
SET IBD=$$SLINE(IBD,IBX,57,10)
End DoDot:4
+82 SET IBLN=$$SET(IBT,IBD,IBLN,IBLR)
SET IBT=""
End DoDot:3
End DoDot:2
End DoDot:1
+83 ;
+84 ;IB*2.0*516 - Display links from 3rd party bill to 1st party bill(s)
+85 KILL ^TMP("IBRBF",$JOB)
+86 DO RELBILL^IBRFN(IBIFN)
+87 NEW IBCIFN,IBCNT
+88 SET IBCNT=0
SET IBCIFN=""
FOR
SET IBCIFN=$ORDER(^TMP("IBRBF",$JOB,IBIFN,IBCIFN))
if IBCIFN=""
QUIT
Begin DoDot:1
+89 IF $PIECE(^(IBCIFN),"^",6)["RX COPAY"
KILL ^TMP("IBRBF",$JOB,IBIFN,IBCIFN)
QUIT
+90 SET IBCNT=IBCNT+1
End DoDot:1
+91 DO HDR2
+92 IF IBCNT=0
SET (IBT,IBD)=""
SET IBX="No Links to 1st Party Bills Found"
SET IBD=$$SLINE(IBD,IBX,0,35)
SET IBLN=$$SET(IBT,IBD,IBLN,IBLR)
QUIT
+93 SET (IBD,IBX,IBT)=""
+94 SET IBCIFN=""
FOR
SET IBCIFN=$ORDER(^TMP("IBRBF",$JOB,IBIFN,IBCIFN))
if IBCIFN=""
QUIT
DO PRINT2
+95 KILL ^TMP("IBRBF",$JOB)
+96 QUIT
+97 ;
EXT(STR,DT,USER) ; returns external form of user and date, given their position in the string
+1 NEW X,Y
SET Y=""
SET STR=$GET(STR)
SET DT=+$GET(DT)
SET USER=+$GET(USER)
+2 SET X=$PIECE(STR,U,DT)
SET DT=""
IF +X
SET DT=$EXTRACT(X,4,5)_"/"_$EXTRACT(X,6,7)_"/"_$EXTRACT(X,2,3)
+3 SET X=$PIECE(STR,U,USER)
SET USER=""
IF +X
SET USER=$PIECE($GET(^VA(200,+X,0)),U,1)
+4 SET Y=DT_" by "_$SELECT(USER="":"UNKNOWN",1:USER)
+5 QUIT Y
+6 ;
SET(IBT,IBD,IBLN,IBLR) ;
+1 NEW LN
SET LN=$$SET^IBJTCA1(IBT,IBD,IBLN,IBLR)
+2 QUIT LN
+3 ;
SLINE(IBD,DATA,COL,WD) ; format a single line with multiple data fields
+1 SET IBD=$EXTRACT(IBD,1,(COL-1))
SET IBD=IBD_$JUSTIFY("",(COL-$LENGTH(IBD)))
SET IBD=IBD_$EXTRACT(DATA,1,WD)
+2 QUIT IBD
+3 ;
HDR2 ;Print the header for first party bills - IB*2*516
+1 SET (IBT,IBD)=""
SET IBLR=1
SET IBNC(1)=26
+2 SET IBLN=$$SET(IBT,IBD,IBLN,1)
+3 SET IBT="Related First Party Charges"
SET IBLN=$$SETN^IBJTCA1(IBT,IBLN,IBLR,1)
+4 SET (IBT,IBD)=""
SET IBLN=$$SET(IBT,IBD,IBLN,1)
+5 SET IBTC(1)=0
SET IBTW(1)=1
SET IBSW(1)=80
SET IBLR=1
SET IBNC(1)=26
+6 SET IBT="Bill# Charge Type Status Amt Billed On Hold Balance"
+7 SET IBLN=$$SET(IBT,IBD,IBLN,IBLR)
DO CNTRL^VALM10(IBLN-1,(IBTC(1)+IBTW(1)),IBSW(1),IOUON,IOUOFF)
+8 QUIT
+9 ;
PRINT2 ;Print the detail line for a first party bill - IB*2*516
+1 SET IBTC(1)=0
SET IBTW(1)=0
SET IBSW(1)=80
SET IBLR=1
+2 SET IBDAT=$GET(^TMP("IBRBF",$JOB,IBIFN,IBCIFN))
SET IBD=""
+3 SET IBX=$PIECE(IBDAT,"^",4)
if IBX=""
SET IBX="Not Assigned"
SET IBD=$$SLINE(IBD,IBX,0,13)
+4 SET IBX=$PIECE(IBDAT,"^",6)
SET IBD=$$SLINE(IBD,IBX,14,12)
+5 SET IBX=$$GET1^DIQ(350,IBCIFN_",",.05)
if IBX=""
SET IBX="Incomplete"
SET IBD=$$SLINE(IBD,IBX,27,11)
+6 SET IBFN=$PIECE(IBDAT,"^",4)
IF IBFN
SET IBFN=$ORDER(^PRCA(430,"B",IBFN,0))
+7 SET IBX=$JUSTIFY($PIECE(IBDAT,"^",5),9,2)
SET IBD=$$SLINE(IBD,IBX,40,10)
+8 SET IBX=$PIECE(IBDAT,"^",7)
SET IBD=$$SLINE(IBD,IBX,53,10)
+9 SET IBX=$JUSTIFY($SELECT($GET(^PRCA(430,+IBFN,7)):+($PIECE(^(7),"^")+$PIECE(^(7),"^",2)+$PIECE(^(7),"^",3)+$PIECE(^(7),"^",4)+$PIECE(^(7),"^",4)),1:0),9,2)
SET IBD=$$SLINE(IBD,IBX,63,10)
+10 SET IBLN=$$SET(IBT,IBD,IBLN,1)
+11 QUIT
+12 ;
STAT(RCIBFN) ;AR Status
+1 IF '$GET(RCIBFN)
QUIT ""
+2 NEW RCSTAT
+3 SET RCSTAT=$PIECE($GET(^PRCA(430,+RCIBFN,0)),"^",8)
SET RCSTAT=$PIECE($GET(^PRCA(430.3,+RCSTAT,0)),"^",2)
+4 QUIT RCSTAT
+5 ;
DATE(X) ; Convert FileMan date to mm/dd/yy
+1 QUIT $SELECT($GET(X):$EXTRACT(X,4,5)_"/"_$EXTRACT(X,6,7)_"/"_$EXTRACT(X,2,3),1:"")
+2 ;
