source: FOIAVistA/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDPTPLI.m@ 1417

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

initial load of FOIAVistA 6/30/08 version
File size: 8.1 KB
Line 
1RCDPTPLI ;WISC/RFJ-transaction profile init to build array ;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 ; requires rctranda
9 N %,COMMDA,DATA,DATA3,DATA8,RCDPDATA,RCFYDA,RCLINE,RCSPACE,RCX,SHOWBAL,SHOWCOL,TOTAL3,TOTAL8,TRANTYPE
10 K ^TMP("RCDPTPLM",$J),^TMP("VALM VIDEO",$J)
11 ;
12 D DIQ433^RCDPTPLM(RCTRANDA,".01;.03;5.02;5.03;11;12;13;14;15;17;19;42;86;88;")
13 S TRANTYPE=RCDPDATA(433,RCTRANDA,12,"I")
14 ;
15 S RCSPACE="",$P(RCSPACE," ",81)=""
16 ;
17 ; set the listmanager line number 1
18 S RCLINE=1
19 D SET("Transaction",RCLINE,1,40,.01)
20 D SET("Type",RCLINE,41,80,12)
21 ;
22 S RCLINE=RCLINE+1
23 D SET(" TransDate",RCLINE,1,80,11)
24 ; increase/decrease adjustment
25 I TRANTYPE=1!(TRANTYPE=35) D
26 . I RCDPDATA(433,RCTRANDA,88,"I") D SET("Contract Adj",RCLINE,47,80)
27 . D SET("Adjustment",RCLINE,64,80,14)
28 ; payment
29 I TRANTYPE=2!(TRANTYPE=34) D SET("Receipt",RCLINE,38,80,13)
30 ; terminated
31 I TRANTYPE=8!(TRANTYPE=9) D SET("TermReason",RCLINE,35,80,17)
32 ;
33 S RCLINE=RCLINE+1
34 D SET(" Processed",RCLINE,1,80,19)
35 D SET(" By",RCLINE,41,80,42)
36 ;
37 S RCLINE=RCLINE+1
38 D SET(" Trans Amt: "_$J(RCDPDATA(433,RCTRANDA,15,"E"),0,2),RCLINE,1,80)
39 ;
40 S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)
41 ;
42 ; fiscal year multiple
43 S RCLINE=RCLINE+1
44 D SET("Fiscal Year",RCLINE,28,40,0,IOUON,IOUOFF)
45 D SET("Principal Amount",RCLINE,44,60,0,IOUON,IOUOFF)
46 D SET("FY Trans Amount",RCLINE,64,80,0,IOUON,IOUOFF)
47 S RCFYDA=0 F S RCFYDA=$O(^PRCA(433,RCTRANDA,4,RCFYDA)) Q:'RCFYDA D
48 . S DATA=$G(^PRCA(433,RCTRANDA,4,RCFYDA,0))
49 . S RCLINE=RCLINE+1
50 . D SET($J($P(DATA,"^"),38),RCLINE,1,80) ;fiscal year
51 . D SET($J($P(DATA,"^",2),19,2),RCLINE,41,60) ;prin amt
52 . D SET($J($P(DATA,"^",5),19,2),RCLINE,60,80) ;fy trans amt
53 ;
54 ; admin cost/charge
55 I TRANTYPE=12!(TRANTYPE=13)!(TRANTYPE=14) D
56 . S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)
57 . S DATA=$P($G(^PRCA(433,RCTRANDA,2)),"^",1,9)
58 . I $TR(DATA,"^0")="" Q
59 . S RCLINE=RCLINE+1 D SET("Administrative Cost Charge:",RCLINE,1,80,0,IOUON,IOUOFF)
60 . I $P(DATA,"^",1) S RCLINE=RCLINE+1 D SET(" IRS Locator: "_$J($P(DATA,"^",1),10,2),RCLINE,1,80)
61 . I $P(DATA,"^",2) S RCLINE=RCLINE+1 D SET(" Credit Agency: "_$J($P(DATA,"^",2),10,2),RCLINE,1,80)
62 . I $P(DATA,"^",3) S RCLINE=RCLINE+1 D SET(" DMV Locator: "_$J($P(DATA,"^",3),10,2),RCLINE,1,80)
63 . I $P(DATA,"^",4) S RCLINE=RCLINE+1 D SET(" Consumer Rep: "_$J($P(DATA,"^",4),10,2),RCLINE,1,80)
64 . I $P(DATA,"^",5) S RCLINE=RCLINE+1 D SET(" Marshall Fee: "_$J($P(DATA,"^",5),10,2),RCLINE,1,80)
65 . I $P(DATA,"^",6) S RCLINE=RCLINE+1 D SET(" Court Cost: "_$J($P(DATA,"^",6),10,2),RCLINE,1,80)
66 . I $P(DATA,"^",7) S RCLINE=RCLINE+1 D SET("Interest Charge: "_$J($P(DATA,"^",7),10,2),RCLINE,1,80)
67 . I $P(DATA,"^",8) S RCLINE=RCLINE+1 D SET(" Admin Charge: "_$J($P(DATA,"^",8),10,2),RCLINE,1,80)
68 . I $P(DATA,"^",9) S RCLINE=RCLINE+1 D SET(" Penalty Charge: "_$J($P(DATA,"^",9),10,2),RCLINE,1,80)
69 ;
70 ;
71 ; collections and balances
72 ; set flag to display balances if there are any
73 S DATA8=$P($G(^PRCA(433,RCTRANDA,8)),"^",1,5)
74 S SHOWBAL=1 I $TR(DATA8,"^0")="" S SHOWBAL=0
75 ; set flag to display collections if there are any
76 S DATA3=$P($G(^PRCA(433,RCTRANDA,3)),"^",1,5)
77 S SHOWCOL=1 I $TR(DATA3,"^0")="" S SHOWCOL=0
78 ; show data
79 I SHOWBAL!(SHOWCOL) D
80 . S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)
81 . F %=1:1:5 S TOTAL3=$G(TOTAL3)+$P(DATA3,"^",%),TOTAL8=$G(TOTAL8)+$P(DATA8,"^",%)
82 . S RCLINE=RCLINE+1 D SET("Balances",RCLINE,19,26,0,IOUON,IOUOFF)
83 . I SHOWCOL D SET("Collections",RCLINE,34,55,0,IOUON,IOUOFF)
84 . S RCLINE=RCLINE+1 D SET(" Principal: "_$J($P(DATA8,"^",1),10,2),RCLINE,1,80)
85 . I SHOWCOL D SET($J($P(DATA3,"^",1),10,2),RCLINE,35,55)
86 . S RCLINE=RCLINE+1 D SET(" Interest: "_$J($P(DATA8,"^",2),10,2),RCLINE,1,80)
87 . I SHOWCOL D SET($J($P(DATA3,"^",2),10,2),RCLINE,35,55)
88 . S RCLINE=RCLINE+1 D SET("Administrative: "_$J($P(DATA8,"^",3),10,2),RCLINE,1,80)
89 . I SHOWCOL D SET($J($P(DATA3,"^",3),10,2),RCLINE,35,55)
90 . S RCLINE=RCLINE+1 D SET(" Marshall Fee: "_$J($P(DATA8,"^",4),10,2),RCLINE,1,80)
91 . I SHOWCOL D SET($J($P(DATA3,"^",4),10,2),RCLINE,35,55)
92 . S RCLINE=RCLINE+1 D SET(" Court Cost: "_$J($P(DATA8,"^",5),10,2),RCLINE,1,80,0,IOUON,IOUOFF)
93 . I SHOWCOL D SET($J($P(DATA3,"^",5),10,2),RCLINE,35,55,0,IOUON,IOUOFF)
94 . S RCLINE=RCLINE+1 D SET(" Total: "_$J(TOTAL8,10,2),RCLINE,1,80)
95 . I SHOWCOL D SET($J(TOTAL3,10,2),RCLINE,35,55)
96 ;
97 ; brief comments, followup date
98 S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)
99 S RCLINE=RCLINE+1 D SET("Brief Comment",RCLINE,1,80,5.02)
100 D SET("Follow-up Date",RCLINE,51,80,5.03)
101 ;
102 ; comments
103 S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)
104 S RCLINE=RCLINE+1 D SET("Comments:",RCLINE,1,80,0,IOUON,IOUOFF)
105 I RCDPDATA(433,RCTRANDA,86,"E")'="" S RCLINE=RCLINE+1 D SET("",RCLINE,1,80,86)
106 S COMMDA=0 F S COMMDA=$O(^PRCA(433,RCTRANDA,7,COMMDA)) Q:'COMMDA D
107 . S RCX=^PRCA(433,RCTRANDA,7,COMMDA,0)
108 . S RCLINE=RCLINE+1 D SET($E(RCX,1,79),RCLINE,1,80)
109 . I $E(RCX,80,159)'="" S RCLINE=RCLINE+1 D SET($E(RCX,80,159),RCLINE,1,80)
110 . I $E(RCX,160,239)'="" S RCLINE=RCLINE+1 D SET($E(RCX,160,239),RCLINE,1,80)
111 S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)
112 ;
113 ; show integrated billing data
114 N BILLCAT,BILLDA,IBDA
115 S BILLDA=+$P(^PRCA(433,RCTRANDA,0),"^",2)
116 S BILLCAT=$P($G(^PRCA(430,BILLDA,0)),"^",2)
117 ; for category c-means test, rx copay (sc/nsc)
118 I BILLCAT=18!(BILLCAT=22)!(BILLCAT=23) D
119 . D STMT^IBRFN1(RCTRANDA)
120 . I '$D(^TMP("IBRFN1",$J)) Q
121 . ; start on 2nd screen if not there already
122 . F RCLINE=RCLINE:1:15 D SET(" ",RCLINE,1,80)
123 . S RCLINE=RCLINE+1 D SET("Integrated Billing Data",RCLINE,1,80,0,IOUON,IOUOFF)
124 . S IBDA=0 F S IBDA=$O(^TMP("IBRFN1",$J,IBDA)) Q:'IBDA D
125 . . S DATA=^TMP("IBRFN1",$J,IBDA)
126 . . ; if more than one ib data transaction to display, skip a line
127 . . I IBDA>1 S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)
128 . . S RCLINE=RCLINE+1 D SET("IB Ref #: "_$P(DATA,"^"),RCLINE,1,80)
129 . . ; show rx
130 . . I BILLCAT=22!(BILLCAT=23) D Q
131 . . . D SET("Pharmacy",RCLINE,28,80)
132 . . . D SET("Charge Amt: "_$J($P(DATA,"^",8),0,2),RCLINE,60,80)
133 . . . S RCLINE=RCLINE+1
134 . . . D SET(" Rx#: "_$P(DATA,"^",2),RCLINE,1,80)
135 . . . D SET("Drug: "_$P(DATA,"^",3),RCLINE,22,80)
136 . . . D SET("Re/Fill Date: "_$E($P(DATA,"^",7),4,5)_"/"_$E($P(DATA,"^",7),6,7)_"/"_$E($P(DATA,"^",7),2,3),RCLINE,58,80)
137 . . . S RCLINE=RCLINE+1
138 . . . D SET(" Physician: "_$P(DATA,"^",5),RCLINE,1,48)
139 . . . D SET("Days Supply: "_$P(DATA,"^",4),RCLINE,48,80)
140 . . . D SET("Qty: "_$P(DATA,"^",6),RCLINE,67,80)
141 . . ; show outpatient (type of care 430.2 = 4 outpatient care)
142 . . I $P(^PRCA(430,BILLDA,0),"^",16)=4 D Q
143 . . . D SET("Outpatient",RCLINE,26,80)
144 . . . D SET("Visit Date: "_$E($P(DATA,"^",2),4,5)_"/"_$E($P(DATA,"^",2),6,7)_"/"_$E($P(DATA,"^",2),2,3),RCLINE,37,80)
145 . . . D SET("Charge Amt: "_$J($P(DATA,"^",8),0,2),RCLINE,60,80)
146 . . ; show inpatient
147 . . D SET("Inpatient",RCLINE,28,80)
148 . . D SET("Charge Amt: "_$J($P(DATA,"^",8),0,2),RCLINE,60,80)
149 . . S RCLINE=RCLINE+1
150 . . D SET(" Admission Date: "_$E($P(DATA,"^",2),4,5)_"/"_$E($P(DATA,"^",2),6,7)_"/"_$E($P(DATA,"^",2),2,3),RCLINE,1,80)
151 . . D SET("Discharge Date: "_$E($P(DATA,"^",5),4,5)_"/"_$E($P(DATA,"^",5),6,7)_"/"_$E($P(DATA,"^",5),2,3),RCLINE,56,80)
152 . . S RCLINE=RCLINE+1
153 . . D SET(" Bill Cycle Begin Date: "_$E($P(DATA,"^",3),4,5)_"/"_$E($P(DATA,"^",3),6,7)_"/"_$E($P(DATA,"^",3),2,3),RCLINE,1,80)
154 . . D SET("End Date: "_$E($P(DATA,"^",4),4,5)_"/"_$E($P(DATA,"^",4),6,7)_"/"_$E($P(DATA,"^",4),2,3),RCLINE,62,80)
155 . K ^TMP("IBRFN1",$J)
156 ;
157 ; set valmcnt to number of lines in the list
158 S VALMCNT=RCLINE
159 Q
160 ;
161 ;
162SET(STRING,LINE,COLBEG,COLEND,FIELD,ON,OFF) ; set array
163 I $G(FIELD) S STRING=STRING_$S(STRING="":"",1:": ")_$G(RCDPDATA(433,RCTRANDA,FIELD,"E"))
164 I STRING="",'$G(FIELD) Q
165 I '$D(@VALMAR@(LINE,0)) D SET^VALM10(LINE,$J("",80))
166 D SET^VALM10(LINE,$$SETSTR^VALM1(STRING,@VALMAR@(LINE,0),COLBEG,COLEND-COLBEG+1))
167 I $G(ON)]""!($G(OFF)]"") D CNTRL^VALM10(LINE,COLBEG,$L(STRING),ON,OFF)
168 Q
Note: See TracBrowser for help on using the repository browser.