source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBJTTB1.m@ 1310

IBJTTB1 ;ALB/ARH - TPI AR TRANSACTION PROFILE BUILD ; 07-APR-1995
 ;;Version 2.0 ; INTEGRATED BILLING ;**39**; 21-MAR-94
 ;;Per VHA Directive 10-93-142, this routine should not be modified.
 ;
BLD ; build array for list manager AR TRANSACTION
 ; input:  DFN, IBIFN - ptr to bill (399), IBTRNS - ptr to transaction (433)
 N IBI,IBJ,IBX,IBRCT0,IBRCT1,IBRCT2,IBRCT3,IBRCT5,IBRCT8,IBLN,IBSTR,IBD,IBT,IBT1,IBT2,IBT3,IBLL,IBRL,IBLC,IBRC,IBLW,IBRW,IBTRTY,IBBC,IBADDM,STRG
 Q:'$G(IBTRNS)
 S IBLL=16,IBRL=16,IBLC=2,IBRC=35,IBLW=12+IBLL,IBRW=25+IBRL
 ;
 S IBRCT0=$$N0^RCJIBFN1(IBTRNS),IBRCT1=$$N1^RCJIBFN1(IBTRNS),IBRCT2=$$N2^RCJIBFN1(IBTRNS)
 S IBRCT3=$$N3^RCJIBFN1(IBTRNS),IBRCT5=$$N5^RCJIBFN1(IBTRNS),IBRCT8=$$N8^RCJIBFN1(IBTRNS)
 S IBTRTY=$P($$STNO^RCJIBFN2(+$P(IBRCT1,U,2)),U,3)
 ;
 S IBLN=1,IBSTR=""
 S IBD="TRANS. NO: ",IBD=$J(IBD,IBLL)_$P(IBRCT0,U,1) S IBSTR=$$SETLN(IBD,IBSTR,IBLC,IBLW)
 S IBD="TRANS. TYPE: ",IBD=$J(IBD,IBLL)_$P($$STNO^RCJIBFN2(+$P(IBRCT1,U,2)),U,1) S IBSTR=$$SETLN(IBD,IBSTR,IBRC,IBRW)
 S IBLN=$$SET(IBSTR,IBLN),IBSTR=""
 ;
 S IBD="TRANS. DATE: ",IBD=$J(IBD,IBLL)_$$DATE^IBJU1(+IBRCT1) S IBSTR=$$SETLN(IBD,IBSTR,IBLC,IBLW)
 S IBD="DATE POSTED: ",IBD=$J(IBD,IBLL)_$$DATE^IBJU1(+$P(IBRCT1,U,7))
 S IBD=IBD_"  ("_$P($G(^VA(200,+$P(IBRCT0,U,3),0)),U,2)_")" S IBSTR=$$SETLN(IBD,IBSTR,IBRC,IBRW)
 S IBLN=$$SET(IBSTR,IBLN),IBSTR=""
 ;
 S IBD="TRANS. AMOUNT: ",IBD=$J(IBD,IBLL)_$FN($P(IBRCT1,U,5),",",2) S IBSTR=$$SETLN(IBD,IBSTR,IBLC,IBLW)
 I IBTRTY=2!(IBTRTY=20) S IBD="RECEIPT #: ",IBD=$J(IBD,IBLL)_$P(IBRCT1,U,3) S IBSTR=$$SETLN(IBD,IBSTR,IBRC,IBRW)
 S IBLN=$$SET(IBSTR,IBLN),IBSTR=""
 ;
 I IBTRTY=21!(IBTRTY=1) S IBD="ADJUSTMENT #: ",IBD=$J(IBD,IBLL)_$P(IBRCT1,U,4) S IBSTR=$$SETLN(IBD,IBSTR,IBLC,IBLW)
 I $P(IBRCT0,U,2)'="" I IBTRTY=1!((IBTRTY>7)&(IBTRTY<12))!(IBTRTY=21)!(IBTRTY=29)!(IBTRTY=30) D
 . S IBD="DATE CALM DONE: ",IBD=$J(IBD,IBLL)_$$DATE^IBJU1($P(IBRCT0,U,2)) S IBSTR=$$SETLN(IBD,IBSTR,IBRC,IBRW)
 I IBSTR'="" S IBLN=$$SET(IBSTR,IBLN),IBSTR=""
 ;
 I IBTRTY=17!($P(IBRCT5,U,2)'="") S IBD="FOLLOW-UP DATE: ",IBD=$J(IBD,IBLL)_$$DATE^IBJU1($P(IBRCT5,U,2)) S IBSTR=$$SETLN(IBD,IBSTR,IBLC,IBLW)
 I IBSTR'="" S IBLN=$$SET(IBSTR,IBLN),IBSTR=""
 ;
 I $P(IBRCT0,U,4)["INCOMPLETE" S IBLN=$$SET(" ",IBLN) D
 . S IBD="NOTE: ",IBD=$J(IBD,IBLL)_$P(IBRCT0,U,4) S IBSTR=$$SETLN(IBD,"",IBLC,79),IBLN=$$SET(IBSTR,IBLN) S IBSTR=""
 ;
 I IBTRTY=8!(IBTRTY=9) S IBLN=$$SET(" ",IBLN) D  S IBLN=$$SET(IBSTR,IBLN) S IBSTR=""
 . S IBT=22,IBSTR="TERMINATION REASON: ",IBD=$P(IBRCT1,U,6) S IBSTR=$$SETLN(IBD,IBSTR,IBT,50)
 ;
 ; balance and collection amounts
 D BCSCR^IBJTTB2
 ;
 ; administrative charges
 I IBRCT2'="",IBTRTY=12 S IBLN=$$SET(" ",IBLN) S IBSTR="" D
 . S IBT=2,IBD="ADMINISTRATIVE COST CHARGE: " S IBSTR=$$SETLN(IBD,IBSTR,IBT,29)
 . D ADDM^IBJTTB2 S IBI=0 F  S IBI=$O(IBADDM(IBI)) Q:'IBI  D  S IBLN=$$SET(IBSTR,IBLN) S IBSTR=""
 .. S IBT=32,IBD=$P(IBADDM(IBI),U,1) S IBSTR=$$SETLN(IBD,IBSTR,IBT,17)
 .. S IBT=50,IBD=$J($P(IBADDM(IBI),U,2),11,2) S IBSTR=$$SETLN(IBD,IBSTR,IBT,11)
 ;
 K STRG D N4^RCJIBFN1(IBTRNS) S (IBI,IBJ)=0 F  S IBI=$O(STRG(IBI)) Q:'IBI  D  S IBLN=$$SET(IBSTR,IBLN) S IBSTR=""
 . S IBX=STRG(IBI) Q:IBX=""  S IBJ=IBJ+1
 . I IBJ=1 S IBLN=$$SET(" ",IBLN)
 . S IBT=7,IBD=$S(IBJ=1:"FY: ",1:"    ")_$P(IBX,U,1) S IBSTR=$$SETLN(IBD,IBSTR,IBT,8)
 . S IBT=28,IBD=$S(IBJ=1:"PR AMT: ",1:"        ")_$FN(+$P(IBX,U,2),",",2) S IBSTR=$$SETLN(IBD,IBSTR,IBT,21)
 . S IBT=57,IBD=$S(IBJ=1:"FY TR AMT: ",1:"           ")_$FN(+$P(IBX,U,4),",",2) S IBSTR=$$SETLN(IBD,IBSTR,IBT,22)
 K STRG
 ;
 S IBLN=$$SET(" ",IBLN),IBSTR="COMMENTS: "
 S IBT=11,IBD=$P(IBRCT5,U,1) I IBD'="" S IBSTR=$$SETLN(IBD,IBSTR,IBT,45),IBLN=$$SET(IBSTR,IBLN) S IBSTR=""
 D TRCOMM^IBJTTB2,COMM^IBJTTB2
 ;
 S VALMCNT=IBLN-1
 ;
 Q
 ;
SETLN(STR,IBX,COL,WD) ;
 S IBX=$$SETSTR^VALM1(STR,IBX,COL,WD)
 Q IBX
 ;
SET(STR,LN) ; set up TMP array with screen data
 N IBX,IBI
 D SET^VALM10(LN,STR)
 S LN=LN+1
SETQ Q LN