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

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

initial load of WorldVistAEHR

File size: 3.8 KB
Line 
1IBJTTB1 ;ALB/ARH - TPI AR TRANSACTION PROFILE BUILD ; 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 ;
5BLD ; build array for list manager AR TRANSACTION
6 ; input: DFN, IBIFN - ptr to bill (399), IBTRNS - ptr to transaction (433)
7 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
8 Q:'$G(IBTRNS)
9 S IBLL=16,IBRL=16,IBLC=2,IBRC=35,IBLW=12+IBLL,IBRW=25+IBRL
10 ;
11 S IBRCT0=$$N0^RCJIBFN1(IBTRNS),IBRCT1=$$N1^RCJIBFN1(IBTRNS),IBRCT2=$$N2^RCJIBFN1(IBTRNS)
12 S IBRCT3=$$N3^RCJIBFN1(IBTRNS),IBRCT5=$$N5^RCJIBFN1(IBTRNS),IBRCT8=$$N8^RCJIBFN1(IBTRNS)
13 S IBTRTY=$P($$STNO^RCJIBFN2(+$P(IBRCT1,U,2)),U,3)
14 ;
15 S IBLN=1,IBSTR=""
16 S IBD="TRANS. NO: ",IBD=$J(IBD,IBLL)_$P(IBRCT0,U,1) S IBSTR=$$SETLN(IBD,IBSTR,IBLC,IBLW)
17 S IBD="TRANS. TYPE: ",IBD=$J(IBD,IBLL)_$P($$STNO^RCJIBFN2(+$P(IBRCT1,U,2)),U,1) S IBSTR=$$SETLN(IBD,IBSTR,IBRC,IBRW)
18 S IBLN=$$SET(IBSTR,IBLN),IBSTR=""
19 ;
20 S IBD="TRANS. DATE: ",IBD=$J(IBD,IBLL)_$$DATE^IBJU1(+IBRCT1) S IBSTR=$$SETLN(IBD,IBSTR,IBLC,IBLW)
21 S IBD="DATE POSTED: ",IBD=$J(IBD,IBLL)_$$DATE^IBJU1(+$P(IBRCT1,U,7))
22 S IBD=IBD_" ("_$P($G(^VA(200,+$P(IBRCT0,U,3),0)),U,2)_")" S IBSTR=$$SETLN(IBD,IBSTR,IBRC,IBRW)
23 S IBLN=$$SET(IBSTR,IBLN),IBSTR=""
24 ;
25 S IBD="TRANS. AMOUNT: ",IBD=$J(IBD,IBLL)_$FN($P(IBRCT1,U,5),",",2) S IBSTR=$$SETLN(IBD,IBSTR,IBLC,IBLW)
26 I IBTRTY=2!(IBTRTY=20) S IBD="RECEIPT #: ",IBD=$J(IBD,IBLL)_$P(IBRCT1,U,3) S IBSTR=$$SETLN(IBD,IBSTR,IBRC,IBRW)
27 S IBLN=$$SET(IBSTR,IBLN),IBSTR=""
28 ;
29 I IBTRTY=21!(IBTRTY=1) S IBD="ADJUSTMENT #: ",IBD=$J(IBD,IBLL)_$P(IBRCT1,U,4) S IBSTR=$$SETLN(IBD,IBSTR,IBLC,IBLW)
30 I $P(IBRCT0,U,2)'="" I IBTRTY=1!((IBTRTY>7)&(IBTRTY<12))!(IBTRTY=21)!(IBTRTY=29)!(IBTRTY=30) D
31 . S IBD="DATE CALM DONE: ",IBD=$J(IBD,IBLL)_$$DATE^IBJU1($P(IBRCT0,U,2)) S IBSTR=$$SETLN(IBD,IBSTR,IBRC,IBRW)
32 I IBSTR'="" S IBLN=$$SET(IBSTR,IBLN),IBSTR=""
33 ;
34 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)
35 I IBSTR'="" S IBLN=$$SET(IBSTR,IBLN),IBSTR=""
36 ;
37 I $P(IBRCT0,U,4)["INCOMPLETE" S IBLN=$$SET(" ",IBLN) D
38 . S IBD="NOTE: ",IBD=$J(IBD,IBLL)_$P(IBRCT0,U,4) S IBSTR=$$SETLN(IBD,"",IBLC,79),IBLN=$$SET(IBSTR,IBLN) S IBSTR=""
39 ;
40 I IBTRTY=8!(IBTRTY=9) S IBLN=$$SET(" ",IBLN) D S IBLN=$$SET(IBSTR,IBLN) S IBSTR=""
41 . S IBT=22,IBSTR="TERMINATION REASON: ",IBD=$P(IBRCT1,U,6) S IBSTR=$$SETLN(IBD,IBSTR,IBT,50)
42 ;
43 ; balance and collection amounts
44 D BCSCR^IBJTTB2
45 ;
46 ; administrative charges
47 I IBRCT2'="",IBTRTY=12 S IBLN=$$SET(" ",IBLN) S IBSTR="" D
48 . S IBT=2,IBD="ADMINISTRATIVE COST CHARGE: " S IBSTR=$$SETLN(IBD,IBSTR,IBT,29)
49 . D ADDM^IBJTTB2 S IBI=0 F S IBI=$O(IBADDM(IBI)) Q:'IBI D S IBLN=$$SET(IBSTR,IBLN) S IBSTR=""
50 .. S IBT=32,IBD=$P(IBADDM(IBI),U,1) S IBSTR=$$SETLN(IBD,IBSTR,IBT,17)
51 .. S IBT=50,IBD=$J($P(IBADDM(IBI),U,2),11,2) S IBSTR=$$SETLN(IBD,IBSTR,IBT,11)
52 ;
53 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=""
54 . S IBX=STRG(IBI) Q:IBX="" S IBJ=IBJ+1
55 . I IBJ=1 S IBLN=$$SET(" ",IBLN)
56 . S IBT=7,IBD=$S(IBJ=1:"FY: ",1:" ")_$P(IBX,U,1) S IBSTR=$$SETLN(IBD,IBSTR,IBT,8)
57 . S IBT=28,IBD=$S(IBJ=1:"PR AMT: ",1:" ")_$FN(+$P(IBX,U,2),",",2) S IBSTR=$$SETLN(IBD,IBSTR,IBT,21)
58 . S IBT=57,IBD=$S(IBJ=1:"FY TR AMT: ",1:" ")_$FN(+$P(IBX,U,4),",",2) S IBSTR=$$SETLN(IBD,IBSTR,IBT,22)
59 K STRG
60 ;
61 S IBLN=$$SET(" ",IBLN),IBSTR="COMMENTS: "
62 S IBT=11,IBD=$P(IBRCT5,U,1) I IBD'="" S IBSTR=$$SETLN(IBD,IBSTR,IBT,45),IBLN=$$SET(IBSTR,IBLN) S IBSTR=""
63 D TRCOMM^IBJTTB2,COMM^IBJTTB2
64 ;
65 S VALMCNT=IBLN-1
66 ;
67 Q
68 ;
69SETLN(STR,IBX,COL,WD) ;
70 S IBX=$$SETSTR^VALM1(STR,IBX,COL,WD)
71 Q IBX
72 ;
73SET(STR,LN) ; set up TMP array with screen data
74 N IBX,IBI
75 D SET^VALM10(LN,STR)
76 S LN=LN+1
77SETQ Q LN
Note: See TracBrowser for help on using the repository browser.