IBJTTB2 ;ALB/ARH - TPI AR TRANSACTION PROFILE (CONT) ; 07-APR-1995
;;Version 2.0 ; INTEGRATED BILLING ;**39**; 21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
BC ; balance and collection amounts:
; returns: IBBC= total balance ^ total collected
; IBBC(x) = data lable ^ $ balance ^ $ collected
S IBBC=0 Q:IBRCT8=""
;
S IBBC=+$P(IBRCT8,U,6)_U_+$P(IBRCT3,U,6)
S IBBC(1)="PRINCIPLE: "_U_+IBRCT8_U_$S(IBRCT3'="":+IBRCT3,1:"")
S IBBC(2)="INTEREST: "_U_+$P(IBRCT8,U,2)_U_$S(IBRCT3'="":$P(IBRCT3,U,2),1:"")
S IBBC(3)="ADMINISTRATIVE: "_U_+$P(IBRCT8,U,3)_U_$S(IBRCT3'="":$P(IBRCT3,U,3),1:"")
S IBBC(4)="MARSHALL FEE: "_U_+$P(IBRCT8,U,4)_U_$S(IBRCT3'="":$P(IBRCT3,U,4),1:"")
S IBBC(5)="COURT COST: "_U_+$P(IBRCT8,U,5)_U_$S(IBRCT3'="":$P(IBRCT3,U,5),1:"")
Q
;
ADDM ; administrative charges
; returns: IBADDM(x) = data lable ^ $ amount - only if $ amount not 0
S IBADDM="" Q:IBRCT2="" N IBI S IBI=1
I $P(IBRCT2,U,1)>0 S IBADDM(IBI)="IRS LOCATOR: "_U_$P(IBRCT2,U,1),IBI=IBI+1
I $P(IBRCT2,U,2)>0 S IBADDM(IBI)="CREDIT AGENCY: "_U_$P(IBRCT2,U,2),IBI=IBI+1
I $P(IBRCT2,U,3)>0 S IBADDM(IBI)="DMV LOCATOR: "_U_$P(IBRCT2,U,3),IBI=IBI+1
I $P(IBRCT2,U,4)>0 S IBADDM(IBI)="CONSUMER REP: "_U_$P(IBRCT2,U,4),IBI=IBI+1
I $P(IBRCT2,U,5)>0 S IBADDM(IBI)="MARSHALL FEE: "_U_$P(IBRCT2,U,5),IBI=IBI+1
I $P(IBRCT2,U,6)>0 S IBADDM(IBI)="COURT COST: "_U_$P(IBRCT2,U,6),IBI=IBI+1
I $P(IBRCT2,U,7)>0 S IBADDM(IBI)="INTEREST CHARGE: "_U_$P(IBRCT2,U,7),IBI=IBI+1
I $P(IBRCT2,U,8)>0 S IBADDM(IBI)="ADM. CHARGE: "_U_$P(IBRCT2,U,8),IBI=IBI+1
Q
;
TRCOMM ; sets TRANS. COMMENTS (433,86) into list manager array for display (if any)
; requires IBRCT8 and IBSTR - contains lable
N X,IBI,IBCNT,IBARR
S X=$P(IBRCT8,U,7) I X'="" D FSTRNG^IBJU1(X,68,.IBARR)
I +$G(IBARR) S (IBI,IBCNT)=0 F S IBI=$O(IBARR(IBI)) Q:'IBI D
. S IBT=11,IBD=IBARR(IBI) S IBSTR=$$SETLN^IBJTTB1(IBD,IBSTR,IBT,69),IBLN=$$SET^IBJTTB1(IBSTR,IBLN),IBSTR=""
Q
;
COMM ; sets COMMENTS (433,41) into list manager array for display (if any)
; requires IBTRNS - ptr to 433 transaction, IBSTR - lable
N X,IBI,IBCNT,COM,DIWL,DIWR,DIWF K ^UTILITY($J,"W")
K COM D N7^RCJIBFN1(IBTRNS) S IBI=0 F S IBI=$O(COM(IBI)) Q:'IBI D
. S X=COM(IBI) I X'="" S DIWL=1,DIWR=68,DIWF="" D ^DIWP
I $D(^UTILITY($J,"W")) S (IBI,IBCNT)=0 F S IBI=$O(^UTILITY($J,"W",1,IBI)) Q:'IBI D
. S IBT=11,IBD=$G(^UTILITY($J,"W",1,IBI,0)) S IBSTR=$$SETLN^IBJTTB1(IBD,IBSTR,IBT,69),IBLN=$$SET^IBJTTB1(IBSTR,IBLN),IBSTR=""
K ^UTILITY($J,"W"),COM
Q
;
BCSCR ; balance and collection amounts: continuation of screen build
I IBRCT3'=""!(IBRCT8'=""&(IBRCT8'?1"0^0^0^0^0^0"1E.E)) S IBLN=$$SET(" ",IBLN) S IBT1=20,IBT2=38,IBT3=52,IBSTR="" D
. S IBT=IBT2,IBD=$J("BALANCE",11) S IBSTR=$$SETLN(IBD,IBSTR,IBT,11)
. I IBRCT3'="" S IBT=IBT3,IBD=$J("COLLECTED",11) S IBSTR=$$SETLN(IBD,IBSTR,IBT,11)
. S IBLN=$$SET(IBSTR,IBLN) S IBSTR=""
. S IBT=IBT2,IBD=$J("-------",11) S IBSTR=$$SETLN(IBD,"",IBT,11)
. I IBRCT3'="" S IBT=IBT3,IBD=$J("---------",11) S IBSTR=$$SETLN(IBD,IBSTR,IBT,11)
. S IBLN=$$SET(IBSTR,IBLN) S IBSTR=""
. ;
. D BC S IBI=0 F S IBI=$O(IBBC(IBI)) Q:'IBI D S IBLN=$$SET(IBSTR,IBLN) S IBSTR=""
.. S IBT=IBT1,IBD=$P(IBBC(IBI),U,1) S IBSTR=$$SETLN(IBD,"",IBT,16)
.. S IBT=IBT2,IBD=$J($P(IBBC(IBI),U,2),11,2) S IBSTR=$$SETLN(IBD,IBSTR,IBT,11)
.. I IBRCT3'="" S IBT=IBT3,IBD=$J($P(IBBC(IBI),U,3),11,2) S IBSTR=$$SETLN(IBD,IBSTR,IBT,11)
. ;
. S IBT=IBT2,IBD=$J("-------",11) S IBSTR=$$SETLN(IBD,"",IBT,11)
. I IBRCT3'="" S IBT=IBT3,IBD=$J("---------",11) S IBSTR=$$SETLN(IBD,IBSTR,IBT,11)
. S IBLN=$$SET(IBSTR,IBLN) S IBSTR=""
. S IBT=IBT1,IBD="TOTAL:" S IBSTR=$$SETLN(IBD,"",IBT,16)
. S IBT=IBT2,IBD=$J(+IBBC,11,2) S IBSTR=$$SETLN(IBD,IBSTR,IBT,11)
. I IBRCT3'="" S IBT=IBT3,IBD=$J(+$P(IBBC,U,2),11,2) S IBSTR=$$SETLN(IBD,IBSTR,IBT,11)
. S IBLN=$$SET(IBSTR,IBLN) S IBSTR=""
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBJTTB2 4126 printed Oct 16, 2024@18:24:49 Page 2
IBJTTB2 ;ALB/ARH - TPI AR TRANSACTION PROFILE (CONT) ; 07-APR-1995
+1 ;;Version 2.0 ; INTEGRATED BILLING ;**39**; 21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
BC ; balance and collection amounts:
+1 ; returns: IBBC= total balance ^ total collected
+2 ; IBBC(x) = data lable ^ $ balance ^ $ collected
+3 SET IBBC=0
if IBRCT8=""
QUIT
+4 ;
+5 SET IBBC=+$PIECE(IBRCT8,U,6)_U_+$PIECE(IBRCT3,U,6)
+6 SET IBBC(1)="PRINCIPLE: "_U_+IBRCT8_U_$SELECT(IBRCT3'="":+IBRCT3,1:"")
+7 SET IBBC(2)="INTEREST: "_U_+$PIECE(IBRCT8,U,2)_U_$SELECT(IBRCT3'="":$PIECE(IBRCT3,U,2),1:"")
+8 SET IBBC(3)="ADMINISTRATIVE: "_U_+$PIECE(IBRCT8,U,3)_U_$SELECT(IBRCT3'="":$PIECE(IBRCT3,U,3),1:"")
+9 SET IBBC(4)="MARSHALL FEE: "_U_+$PIECE(IBRCT8,U,4)_U_$SELECT(IBRCT3'="":$PIECE(IBRCT3,U,4),1:"")
+10 SET IBBC(5)="COURT COST: "_U_+$PIECE(IBRCT8,U,5)_U_$SELECT(IBRCT3'="":$PIECE(IBRCT3,U,5),1:"")
+11 QUIT
+12 ;
ADDM ; administrative charges
+1 ; returns: IBADDM(x) = data lable ^ $ amount - only if $ amount not 0
+2 SET IBADDM=""
if IBRCT2=""
QUIT
NEW IBI
SET IBI=1
+3 IF $PIECE(IBRCT2,U,1)>0
SET IBADDM(IBI)="IRS LOCATOR: "_U_$PIECE(IBRCT2,U,1)
SET IBI=IBI+1
+4 IF $PIECE(IBRCT2,U,2)>0
SET IBADDM(IBI)="CREDIT AGENCY: "_U_$PIECE(IBRCT2,U,2)
SET IBI=IBI+1
+5 IF $PIECE(IBRCT2,U,3)>0
SET IBADDM(IBI)="DMV LOCATOR: "_U_$PIECE(IBRCT2,U,3)
SET IBI=IBI+1
+6 IF $PIECE(IBRCT2,U,4)>0
SET IBADDM(IBI)="CONSUMER REP: "_U_$PIECE(IBRCT2,U,4)
SET IBI=IBI+1
+7 IF $PIECE(IBRCT2,U,5)>0
SET IBADDM(IBI)="MARSHALL FEE: "_U_$PIECE(IBRCT2,U,5)
SET IBI=IBI+1
+8 IF $PIECE(IBRCT2,U,6)>0
SET IBADDM(IBI)="COURT COST: "_U_$PIECE(IBRCT2,U,6)
SET IBI=IBI+1
+9 IF $PIECE(IBRCT2,U,7)>0
SET IBADDM(IBI)="INTEREST CHARGE: "_U_$PIECE(IBRCT2,U,7)
SET IBI=IBI+1
+10 IF $PIECE(IBRCT2,U,8)>0
SET IBADDM(IBI)="ADM. CHARGE: "_U_$PIECE(IBRCT2,U,8)
SET IBI=IBI+1
+11 QUIT
+12 ;
TRCOMM ; sets TRANS. COMMENTS (433,86) into list manager array for display (if any)
+1 ; requires IBRCT8 and IBSTR - contains lable
+2 NEW X,IBI,IBCNT,IBARR
+3 SET X=$PIECE(IBRCT8,U,7)
IF X'=""
DO FSTRNG^IBJU1(X,68,.IBARR)
+4 IF +$GET(IBARR)
SET (IBI,IBCNT)=0
FOR
SET IBI=$ORDER(IBARR(IBI))
if 'IBI
QUIT
Begin DoDot:1
+5 SET IBT=11
SET IBD=IBARR(IBI)
SET IBSTR=$$SETLN^IBJTTB1(IBD,IBSTR,IBT,69)
SET IBLN=$$SET^IBJTTB1(IBSTR,IBLN)
SET IBSTR=""
End DoDot:1
+6 QUIT
+7 ;
COMM ; sets COMMENTS (433,41) into list manager array for display (if any)
+1 ; requires IBTRNS - ptr to 433 transaction, IBSTR - lable
+2 NEW X,IBI,IBCNT,COM,DIWL,DIWR,DIWF
KILL ^UTILITY($JOB,"W")
+3 KILL COM
DO N7^RCJIBFN1(IBTRNS)
SET IBI=0
FOR
SET IBI=$ORDER(COM(IBI))
if 'IBI
QUIT
Begin DoDot:1
+4 SET X=COM(IBI)
IF X'=""
SET DIWL=1
SET DIWR=68
SET DIWF=""
DO ^DIWP
End DoDot:1
+5 IF $DATA(^UTILITY($JOB,"W"))
SET (IBI,IBCNT)=0
FOR
SET IBI=$ORDER(^UTILITY($JOB,"W",1,IBI))
if 'IBI
QUIT
Begin DoDot:1
+6 SET IBT=11
SET IBD=$GET(^UTILITY($JOB,"W",1,IBI,0))
SET IBSTR=$$SETLN^IBJTTB1(IBD,IBSTR,IBT,69)
SET IBLN=$$SET^IBJTTB1(IBSTR,IBLN)
SET IBSTR=""
End DoDot:1
+7 KILL ^UTILITY($JOB,"W"),COM
+8 QUIT
+9 ;
BCSCR ; balance and collection amounts: continuation of screen build
+1 IF IBRCT3'=""!(IBRCT8'=""&(IBRCT8'?1"0^0^0^0^0^0"1E.E))
SET IBLN=$$SET(" ",IBLN)
SET IBT1=20
SET IBT2=38
SET IBT3=52
SET IBSTR=""
Begin DoDot:1
+2 SET IBT=IBT2
SET IBD=$JUSTIFY("BALANCE",11)
SET IBSTR=$$SETLN(IBD,IBSTR,IBT,11)
+3 IF IBRCT3'=""
SET IBT=IBT3
SET IBD=$JUSTIFY("COLLECTED",11)
SET IBSTR=$$SETLN(IBD,IBSTR,IBT,11)
+4 SET IBLN=$$SET(IBSTR,IBLN)
SET IBSTR=""
+5 SET IBT=IBT2
SET IBD=$JUSTIFY("-------",11)
SET IBSTR=$$SETLN(IBD,"",IBT,11)
+6 IF IBRCT3'=""
SET IBT=IBT3
SET IBD=$JUSTIFY("---------",11)
SET IBSTR=$$SETLN(IBD,IBSTR,IBT,11)
+7 SET IBLN=$$SET(IBSTR,IBLN)
SET IBSTR=""
+8 ;
+9 DO BC
SET IBI=0
FOR
SET IBI=$ORDER(IBBC(IBI))
if 'IBI
QUIT
Begin DoDot:2
+10 SET IBT=IBT1
SET IBD=$PIECE(IBBC(IBI),U,1)
SET IBSTR=$$SETLN(IBD,"",IBT,16)
+11 SET IBT=IBT2
SET IBD=$JUSTIFY($PIECE(IBBC(IBI),U,2),11,2)
SET IBSTR=$$SETLN(IBD,IBSTR,IBT,11)
+12 IF IBRCT3'=""
SET IBT=IBT3
SET IBD=$JUSTIFY($PIECE(IBBC(IBI),U,3),11,2)
SET IBSTR=$$SETLN(IBD,IBSTR,IBT,11)
End DoDot:2
SET IBLN=$$SET(IBSTR,IBLN)
SET IBSTR=""
+13 ;
+14 SET IBT=IBT2
SET IBD=$JUSTIFY("-------",11)
SET IBSTR=$$SETLN(IBD,"",IBT,11)
+15 IF IBRCT3'=""
SET IBT=IBT3
SET IBD=$JUSTIFY("---------",11)
SET IBSTR=$$SETLN(IBD,IBSTR,IBT,11)
+16 SET IBLN=$$SET(IBSTR,IBLN)
SET IBSTR=""
+17 SET IBT=IBT1
SET IBD="TOTAL:"
SET IBSTR=$$SETLN(IBD,"",IBT,16)
+18 SET IBT=IBT2
SET IBD=$JUSTIFY(+IBBC,11,2)
SET IBSTR=$$SETLN(IBD,IBSTR,IBT,11)
+19 IF IBRCT3'=""
SET IBT=IBT3
SET IBD=$JUSTIFY(+$PIECE(IBBC,U,2),11,2)
SET IBSTR=$$SETLN(IBD,IBSTR,IBT,11)
+20 SET IBLN=$$SET(IBSTR,IBLN)
SET IBSTR=""
End DoDot:1
+21 QUIT
+22 ;
SETLN(STR,IBX,COL,WD) ;
+1 SET IBX=$$SETSTR^VALM1(STR,IBX,COL,WD)
+2 QUIT IBX
+3 ;
SET(STR,LN) ; set up TMP array with screen data
+1 NEW IBX,IBI
+2 DO SET^VALM10(LN,STR)
+3 SET LN=LN+1
SETQ QUIT LN
