source: FOIAVistA/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDPBPLI.m@ 710

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

initial load of FOIAVistA 6/30/08 version
File size: 7.0 KB
Line 
1RCDPBPLI ;WISC/RFJ-bill profile (build array cont employee/vendor) ;1 Jun 99
2 ;;4.5;Accounts Receivable;**114,153**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7INIT ; initialization for list manager list
8 ; report type for employee or vendor, show description field 106
9 N COMMDA,DATA,DESCDA,TEXT
10 S RCLINE=RCLINE+1 D SET^RCDPBPLM(" ",RCLINE,1,80)
11 S RCLINE=RCLINE+1 D SET^RCDPBPLM("Date ",RCLINE,1,80,0,IOUON,IOUOFF)
12 D SET^RCDPBPLM("Description",RCLINE,12,80,0,IOUON,IOUOFF)
13 D SET^RCDPBPLM("Quantity",RCLINE,35,80,0,IOUON,IOUOFF)
14 D SET^RCDPBPLM("Units",RCLINE,46,80,0,IOUON,IOUOFF)
15 D SET^RCDPBPLM("Cost",RCLINE,54,80,0,IOUON,IOUOFF)
16 D SET^RCDPBPLM("Total Cost",RCLINE,64,80,0,IOUON,IOUOFF)
17 S DESCDA=0 F S DESCDA=$O(^PRCA(430,RCBILLDA,101,DESCDA)) Q:'DESCDA D
18 . S DATA=$G(^PRCA(430,RCBILLDA,101,DESCDA,0)) I DATA="" Q
19 . S RCLINE=RCLINE+1
20 . D SET^RCDPBPLM($E($P(DATA,"^"),4,5)_"/"_$E($P(DATA,"^"),6,7)_"/"_$E($P(DATA,"^"),2,3),RCLINE,1,80)
21 . D SET^RCDPBPLM($J($P(DATA,"^",3),8,2),RCLINE,35,80)
22 . D SET^RCDPBPLM($J($P($G(^PRCD(420.5,+$P(DATA,"^",5),0)),"^"),5),RCLINE,46,80)
23 . D SET^RCDPBPLM($J($P(DATA,"^",4),0,4),RCLINE,54,80)
24 . D SET^RCDPBPLM($J($P(DATA,"^",6),10,2),RCLINE,64,80)
25 . ; show description
26 . S DATA=""
27 . S COMMDA=0 F S COMMDA=$O(^PRCA(430,RCBILLDA,101,DESCDA,1,COMMDA)) Q:'COMMDA D
28 . . S TEXT=$G(^PRCA(430,RCBILLDA,101,DESCDA,1,COMMDA,0)) I TEXT="" Q
29 . . I $L(DATA_TEXT)>240 D SETDESC(11)
30 . . S DATA=DATA_$S(DATA="":"",1:" ")_TEXT
31 . I DATA'="" D SETDESC(11)
32 . ; make sure all data is processed
33 . I DATA'="" D SETDESC(11)
34 Q
35 ;
36 ;
37SETDESC(STARTCOL) ; set the description line starting in column startcol+1
38 N %,LENGTH,SPACE
39 S LENGTH=80-STARTCOL-1
40 S SPACE="",$P(SPACE," ",80)=""
41 ; break text at space if possible
42 I $L(DATA)>LENGTH D
43 . F %=LENGTH-1:-1:0 Q:$E(DATA,%)=" "
44 . I % S LENGTH=%
45 ; set line
46 S RCLINE=RCLINE+1 D SET^RCDPBPLM($E(SPACE,1,STARTCOL)_$E(DATA,1,LENGTH),RCLINE,1,80)
47 S DATA=$E(DATA,LENGTH+1,255)
48 I $L(DATA)>LENGTH D SETDESC(STARTCOL)
49 Q
50 ;
51 ;
52TRANINIT ; initialization for transaction and ib data display
53 N BILLCAT,DATA,IBDA,RCDATE,RCLIST,RCTOTAL,RCTRANDA,X
54 ; get the bill category
55 S BILLCAT=$P($G(^PRCA(430,RCBILLDA,0)),"^",2)
56 S RCLINE=RCLINE+1 D SET^RCDPBPLM(" ",RCLINE,1,80)
57 S RCLINE=RCLINE+1 D SET^RCDPBPLM(" ",RCLINE,1,80)
58 S RCLINE=RCLINE+1 D SET^RCDPBPLM("Trans Date Type Amount Description ",RCLINE,1,80,0,IOUON,IOUOFF)
59 S RCTOTAL=$$GETTRANS^RCDPBTLM(RCBILLDA)
60 S RCDATE=0 F S RCDATE=$O(RCLIST(RCDATE)) Q:'RCDATE D
61 . S RCTRANDA=0 F S RCTRANDA=$O(RCLIST(RCDATE,RCTRANDA)) Q:'RCTRANDA D
62 . . S RCLINE=RCLINE+1
63 . . D SET^RCDPBPLM(RCTRANDA,RCLINE,1,80)
64 . . D SET^RCDPBPLM($E(RCDATE,4,5)_"/"_$E(RCDATE,6,7)_"/"_$E(RCDATE,2,3),RCLINE,10,20)
65 . . D SET^RCDPBPLM($E($P(RCLIST(RCDATE,RCTRANDA),"^"),1,9),RCLINE,20,29)
66 . . S X=$P(RCLIST(RCDATE,RCTRANDA),"^",2)+$P(RCLIST(RCDATE,RCTRANDA),"^",3)+$P(RCLIST(RCDATE,RCTRANDA),"^",4)+$P(RCLIST(RCDATE,RCTRANDA),"^",5)+$P(RCLIST(RCDATE,RCTRANDA),"^",6)
67 . . D SET^RCDPBPLM($J(X,10,2),RCLINE,30,40)
68 . . ;
69 . . ; for category c-means test, rx copay (sc/nsc)
70 . . I BILLCAT=18!(BILLCAT=22)!(BILLCAT=23) D
71 . . . D STMT^IBRFN1(RCTRANDA)
72 . . . I '$D(^TMP("IBRFN1",$J)) Q
73 . . . S IBDA=0 F S IBDA=$O(^TMP("IBRFN1",$J,IBDA)) Q:'IBDA D
74 . . . . S DATA=^TMP("IBRFN1",$J,IBDA)
75 . . . . ; show rx
76 . . . . I BILLCAT=22!(BILLCAT=23) D Q
77 . . . . . D SET^RCDPBPLM("RX "_$P(DATA,"^",2),RCLINE,42,52)
78 . . . . . D SET^RCDPBPLM($P(DATA,"^",3),RCLINE,54,68)
79 . . . . . D SET^RCDPBPLM("Qty "_$P(DATA,"^",6),RCLINE,70,80)
80 . . . . ; show outpatient (type of care 430.2 = 4 outpatient care)
81 . . . . I $P(^PRCA(430,RCBILLDA,0),"^",16)=4 D Q
82 . . . . . D SET^RCDPBPLM("Outpatient Visit Date: "_$E($P(DATA,"^",2),4,5)_"/"_$E($P(DATA,"^",2),6,7)_"/"_$E($P(DATA,"^",2),2,3),RCLINE,42,80)
83 . . . . ; show inpatient
84 . . . . D SET^RCDPBPLM("Inpatient Adm Date: "_$E($P(DATA,"^",2),4,5)_"/"_$E($P(DATA,"^",2),6,7)_"/"_$E($P(DATA,"^",2),2,3),RCLINE,42,80)
85 . . . K ^TMP("IBRFN1",$J)
86 Q
87 ;
88 ;
89REPAY ; show repayment plan
90 S RCLINE=RCLINE+1 D SET^RCDPBPLM(" ",RCLINE,1,80)
91 S RCLINE=RCLINE+1 D SET^RCDPBPLM("Repayment Plan Data",RCLINE,1,80,0,IOUON,IOUOFF)
92 S RCLINE=RCLINE+1 D SET^RCDPBPLM(" Repayment Plan Date",RCLINE,1,80,41)
93 S RCLINE=RCLINE+1 D SET^RCDPBPLM("Day of Month Payment Due",RCLINE,1,80,42)
94 S RCLINE=RCLINE+1 D SET^RCDPBPLM(" Repayment Amount Due",RCLINE,1,80,43)
95 S RCLINE=RCLINE+1 D SET^RCDPBPLM(" Number of Payments",RCLINE,1,80,44)
96 Q
97 ;
98 ;
99IRS ; irs data
100 S RCLINE=RCLINE+1 D SET^RCDPBPLM(" ",RCLINE,1,80)
101 S RCLINE=RCLINE+1 D SET^RCDPBPLM("Forwarded to IRS",RCLINE,1,80,0,IOUON,IOUOFF)
102 S RCLINE=RCLINE+1 D SET^RCDPBPLM("On Date",RCLINE,40,80,68.7)
103 D SET^RCDPBPLM("Amount",RCLINE,65,80,68.92)
104 S DATA=$G(^PRCA(430,RCBILLDA,6))
105 S RCLINE=RCLINE+1 D SET^RCDPBPLM(" Principal Balance: "_$J($P(DATA,"^",16),10,2),RCLINE,1,80)
106 S RCLINE=RCLINE+1 D SET^RCDPBPLM(" Interest Balance: "_$J($P(DATA,"^",17),10,2),RCLINE,1,80)
107 S RCLINE=RCLINE+1 D SET^RCDPBPLM(" Administrative Balance: "_$J($P(DATA,"^",18),10,2),RCLINE,1,80)
108 Q
109 ;
110 ;
111DMC ; dmc data
112 S RCLINE=RCLINE+1 D SET^RCDPBPLM(" ",RCLINE,1,80)
113 S RCLINE=RCLINE+1 D SET^RCDPBPLM("Forwarded to DMC",RCLINE,1,80,0,IOUON,IOUOFF)
114 D SET^RCDPBPLM("On Date",RCLINE,40,80,121)
115 S DATA=$G(^PRCA(430,RCBILLDA,12))
116 S RCLINE=RCLINE+1 D SET^RCDPBPLM(" Principal Balance: "_$J($P(DATA,"^",2),10,2),RCLINE,1,80)
117 S RCLINE=RCLINE+1 D SET^RCDPBPLM(" Interest Balance: "_$J($P(DATA,"^",3),10,2),RCLINE,1,80)
118 S RCLINE=RCLINE+1 D SET^RCDPBPLM(" Administrative Balance: "_$J($P(DATA,"^",4),10,2),RCLINE,1,80)
119 Q
120 ;
121 ;
122TOP ; top data
123 S RCLINE=RCLINE+1 D SET^RCDPBPLM(" ",RCLINE,1,80)
124 S RCLINE=RCLINE+1 D SET^RCDPBPLM("Forwarded to TOP",RCLINE,1,80,0,IOUON,IOUOFF)
125 D SET^RCDPBPLM("On Date",RCLINE,40,80,141)
126 S DATA=$G(^RCD(340,+RCDPDATA(430,RCBILLDA,9,"I"),6))
127 I $P(DATA,"^",6) D
128 . S Y=$P(DATA,"^",6) D DD^%DT
129 . S RCLINE=RCLINE+1 D SET^RCDPBPLM(" TOP Hold Date: "_Y,RCLINE,1,80)
130 Q
131 ;
132 ;
133INSUR ; show insurance data
134 S RCLINE=RCLINE+1 D SET^RCDPBPLM(" ",RCLINE,1,80)
135 S RCLINE=RCLINE+1 D SET^RCDPBPLM("Insurance Data",RCLINE,1,80,0,IOUON,IOUOFF)
136 S RCLINE=RCLINE+1 D SET^RCDPBPLM(" Insured Name",RCLINE,1,80,239)
137 D SET^RCDPBPLM("Sex",RCLINE,50,80,240)
138 S RCLINE=RCLINE+1 D SET^RCDPBPLM(" ID Number",RCLINE,1,80,242)
139 S RCLINE=RCLINE+1 D SET^RCDPBPLM(" Group Name",RCLINE,1,80,243)
140 S RCLINE=RCLINE+1 D SET^RCDPBPLM(" Group Number",RCLINE,1,80,244)
141 S RCLINE=RCLINE+1 D SET^RCDPBPLM(" Employer Name",RCLINE,1,80,247)
142 S RCLINE=RCLINE+1 D SET^RCDPBPLM(" Employee ID Number",RCLINE,1,80,248)
143 S RCLINE=RCLINE+1 D SET^RCDPBPLM(" Employer Location",RCLINE,1,80,249)
144 S RCLINE=RCLINE+1 D SET^RCDPBPLM("Secondary Ins Carrier",RCLINE,1,80,19)
145 S RCLINE=RCLINE+1 D SET^RCDPBPLM(" Tertiary Ins Carrier",RCLINE,1,80,19.1)
146 Q
Note: See TracBrowser for help on using the repository browser.