- 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 Mar 13, 2025@21:29:09 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
