source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBJTTB2.m@ 703

Last change on this file since 703 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.0 KB
Line 
1IBJTTB2 ;ALB/ARH - TPI AR TRANSACTION PROFILE (CONT) ; 07-APR-1995
2 ;;Version 2.0 ; INTEGRATED BILLING ;**39**; 21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5BC ; balance and collection amounts:
6 ; returns: IBBC= total balance ^ total collected
7 ; IBBC(x) = data lable ^ $ balance ^ $ collected
8 S IBBC=0 Q:IBRCT8=""
9 ;
10 S IBBC=+$P(IBRCT8,U,6)_U_+$P(IBRCT3,U,6)
11 S IBBC(1)="PRINCIPLE: "_U_+IBRCT8_U_$S(IBRCT3'="":+IBRCT3,1:"")
12 S IBBC(2)="INTEREST: "_U_+$P(IBRCT8,U,2)_U_$S(IBRCT3'="":$P(IBRCT3,U,2),1:"")
13 S IBBC(3)="ADMINISTRATIVE: "_U_+$P(IBRCT8,U,3)_U_$S(IBRCT3'="":$P(IBRCT3,U,3),1:"")
14 S IBBC(4)="MARSHALL FEE: "_U_+$P(IBRCT8,U,4)_U_$S(IBRCT3'="":$P(IBRCT3,U,4),1:"")
15 S IBBC(5)="COURT COST: "_U_+$P(IBRCT8,U,5)_U_$S(IBRCT3'="":$P(IBRCT3,U,5),1:"")
16 Q
17 ;
18ADDM ; administrative charges
19 ; returns: IBADDM(x) = data lable ^ $ amount - only if $ amount not 0
20 S IBADDM="" Q:IBRCT2="" N IBI S IBI=1
21 I $P(IBRCT2,U,1)>0 S IBADDM(IBI)="IRS LOCATOR: "_U_$P(IBRCT2,U,1),IBI=IBI+1
22 I $P(IBRCT2,U,2)>0 S IBADDM(IBI)="CREDIT AGENCY: "_U_$P(IBRCT2,U,2),IBI=IBI+1
23 I $P(IBRCT2,U,3)>0 S IBADDM(IBI)="DMV LOCATOR: "_U_$P(IBRCT2,U,3),IBI=IBI+1
24 I $P(IBRCT2,U,4)>0 S IBADDM(IBI)="CONSUMER REP: "_U_$P(IBRCT2,U,4),IBI=IBI+1
25 I $P(IBRCT2,U,5)>0 S IBADDM(IBI)="MARSHALL FEE: "_U_$P(IBRCT2,U,5),IBI=IBI+1
26 I $P(IBRCT2,U,6)>0 S IBADDM(IBI)="COURT COST: "_U_$P(IBRCT2,U,6),IBI=IBI+1
27 I $P(IBRCT2,U,7)>0 S IBADDM(IBI)="INTEREST CHARGE: "_U_$P(IBRCT2,U,7),IBI=IBI+1
28 I $P(IBRCT2,U,8)>0 S IBADDM(IBI)="ADM. CHARGE: "_U_$P(IBRCT2,U,8),IBI=IBI+1
29 Q
30 ;
31TRCOMM ; sets TRANS. COMMENTS (433,86) into list manager array for display (if any)
32 ; requires IBRCT8 and IBSTR - contains lable
33 N X,IBI,IBCNT,IBARR
34 S X=$P(IBRCT8,U,7) I X'="" D FSTRNG^IBJU1(X,68,.IBARR)
35 I +$G(IBARR) S (IBI,IBCNT)=0 F S IBI=$O(IBARR(IBI)) Q:'IBI D
36 . S IBT=11,IBD=IBARR(IBI) S IBSTR=$$SETLN^IBJTTB1(IBD,IBSTR,IBT,69),IBLN=$$SET^IBJTTB1(IBSTR,IBLN),IBSTR=""
37 Q
38 ;
39COMM ; sets COMMENTS (433,41) into list manager array for display (if any)
40 ; requires IBTRNS - ptr to 433 transaction, IBSTR - lable
41 N X,IBI,IBCNT,COM,DIWL,DIWR,DIWF K ^UTILITY($J,"W")
42 K COM D N7^RCJIBFN1(IBTRNS) S IBI=0 F S IBI=$O(COM(IBI)) Q:'IBI D
43 . S X=COM(IBI) I X'="" S DIWL=1,DIWR=68,DIWF="" D ^DIWP
44 I $D(^UTILITY($J,"W")) S (IBI,IBCNT)=0 F S IBI=$O(^UTILITY($J,"W",1,IBI)) Q:'IBI D
45 . 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=""
46 K ^UTILITY($J,"W"),COM
47 Q
48 ;
49BCSCR ; balance and collection amounts: continuation of screen build
50 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
51 . S IBT=IBT2,IBD=$J("BALANCE",11) S IBSTR=$$SETLN(IBD,IBSTR,IBT,11)
52 . I IBRCT3'="" S IBT=IBT3,IBD=$J("COLLECTED",11) S IBSTR=$$SETLN(IBD,IBSTR,IBT,11)
53 . S IBLN=$$SET(IBSTR,IBLN) S IBSTR=""
54 . S IBT=IBT2,IBD=$J("-------",11) S IBSTR=$$SETLN(IBD,"",IBT,11)
55 . I IBRCT3'="" S IBT=IBT3,IBD=$J("---------",11) S IBSTR=$$SETLN(IBD,IBSTR,IBT,11)
56 . S IBLN=$$SET(IBSTR,IBLN) S IBSTR=""
57 . ;
58 . D BC S IBI=0 F S IBI=$O(IBBC(IBI)) Q:'IBI D S IBLN=$$SET(IBSTR,IBLN) S IBSTR=""
59 .. S IBT=IBT1,IBD=$P(IBBC(IBI),U,1) S IBSTR=$$SETLN(IBD,"",IBT,16)
60 .. S IBT=IBT2,IBD=$J($P(IBBC(IBI),U,2),11,2) S IBSTR=$$SETLN(IBD,IBSTR,IBT,11)
61 .. I IBRCT3'="" S IBT=IBT3,IBD=$J($P(IBBC(IBI),U,3),11,2) S IBSTR=$$SETLN(IBD,IBSTR,IBT,11)
62 . ;
63 . S IBT=IBT2,IBD=$J("-------",11) S IBSTR=$$SETLN(IBD,"",IBT,11)
64 . I IBRCT3'="" S IBT=IBT3,IBD=$J("---------",11) S IBSTR=$$SETLN(IBD,IBSTR,IBT,11)
65 . S IBLN=$$SET(IBSTR,IBLN) S IBSTR=""
66 . S IBT=IBT1,IBD="TOTAL:" S IBSTR=$$SETLN(IBD,"",IBT,16)
67 . S IBT=IBT2,IBD=$J(+IBBC,11,2) S IBSTR=$$SETLN(IBD,IBSTR,IBT,11)
68 . I IBRCT3'="" S IBT=IBT3,IBD=$J(+$P(IBBC,U,2),11,2) S IBSTR=$$SETLN(IBD,IBSTR,IBT,11)
69 . S IBLN=$$SET(IBSTR,IBLN) S IBSTR=""
70 Q
71 ;
72SETLN(STR,IBX,COL,WD) ;
73 S IBX=$$SETSTR^VALM1(STR,IBX,COL,WD)
74 Q IBX
75 ;
76SET(STR,LN) ; set up TMP array with screen data
77 N IBX,IBI
78 D SET^VALM10(LN,STR)
79 S LN=LN+1
80SETQ Q LN
Note: See TracBrowser for help on using the repository browser.