source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBATLM2A.m@ 1245

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

initial load of FOIAVistA 6/30/08 version
File size: 5.5 KB
Line 
1IBATLM2A ;LL/ELZ - TRANSFER PRICING PT TRANSACTION DETAIL ; 15-SEP-1998
2 ;;2.0;INTEGRATED BILLING;**115,210,266,309,389**;21-MAR-94;Build 6
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 N IBX,IBY K ^TMP("IBATEE",$J)
6 F IBX=0,4,5,6 S IBDATA(IBX)=$G(^IBAT(351.61,IBIEN,IBX))
7 ;
8 S IBY=""
9 D SET("*** General Information ***",.IBY,26,27)
10 D SETVALM(.VALMCNT,.IBY)
11 D CNTRL^VALM10(VALMCNT,26,27,IOINHI,IOINORM)
12 D SETVALM(.VALMCNT,"")
13 ;
14 D SET("Transaction Date:",.IBY,1,17)
15 D SET($$DATE($P(IBDATA(0),"^",3)),.IBY,19,19)
16 D SET("Event Date:",.IBY,48,11)
17 D SET($$DATE($P(IBDATA(0),"^",4)),.IBY,60,20)
18 D SETVALM(.VALMCNT,.IBY)
19 ;
20 D SET("Status:",.IBY,11,7)
21 D SET($$EX^IBATUTL(351.61,.05,$P(IBDATA(0),"^",5)),.IBY,19,19)
22 D SET("Priced Date:",.IBY,47,12)
23 D SET($$DATE($P(IBDATA(0),"^",13)),.IBY,60,20)
24 D SETVALM(.VALMCNT,.IBY)
25 ;
26 D SET("From Date:",.IBY,8,10)
27 D SET($$DATE($P(IBDATA(0),"^",9)),.IBY,19,19)
28 D SET("To Date:",.IBY,51,8)
29 D SET($$DATE($P(IBDATA(0),"^",10)),.IBY,60,20)
30 D SETVALM(.VALMCNT,.IBY)
31 ;
32 D SET("Facility:",.IBY,9,9)
33 D SET($$EX^IBATUTL(351.61,.11,$P(IBDATA(0),"^",11)),.IBY,19,19)
34 D SETVALM(.VALMCNT,.IBY),SETVALM(.VALMCNT,""),SETVALM(.VALMCNT,"")
35 ;
36 D SET("*** Workload/Pricing Detail ***",.IBY,24,31)
37 D SETVALM(.VALMCNT,.IBY)
38 D CNTRL^VALM10(VALMCNT,24,31,IOINHI,IOINORM)
39 ;
40 D @$S($P(IBDATA(0),"^",12)["DGPM(":"INPT",$P(IBDATA(0),"^",12)["SCE(":"OUT",$P(IBDATA(0),"^",12)["RMPR(":"RMPR",1:"RX")
41 ;
42 D SETVALM(.VALMCNT,"")
43 D SET("*** Totals ***",.IBY,33,14)
44 D SETVALM(.VALMCNT,.IBY)
45 D CNTRL^VALM10(VALMCNT,26,28,IOINHI,IOINORM)
46 D SETVALM(.VALMCNT,"")
47 ;
48 D SET("Bill Amount:",.IBY,6,18)
49 D SET($FN($P(IBDATA(6),"^",2),"",2),.IBY,25,54)
50 D SETVALM(.VALMCNT,.IBY)
51 ;
52 D SET("Patient Copay:",.IBY,6,14)
53 S $P(IBDATA(6),"^",3)=$$COPAY^IBATUTL(DFN,$P(IBDATA(0),"^",12),$P(IBDATA(0),"^",9),$P(IBDATA(0),"^",10))
54 D SET($FN($P(IBDATA(6),"^",3),"",2),.IBY,26,54)
55 D SETVALM(.VALMCNT,.IBY)
56 ;
57 Q
58INPT ; -- detail display for inpatient
59 N IBDRG,VAIP
60 ;
61 S IBDRG=$G(^IBAT(351.61,IBIEN,1))
62 ;
63 S VAIP("E")=+$P(IBDATA(0),"^",12) D IN5^VADPT
64 ;
65 D SETVALM(.VALMCNT,"")
66 D SET("Admission Date:",.IBY,3,15)
67 D SET($P(VAIP(13,1),"^",2),.IBY,19,19)
68 D SET("Discharge Date:",.IBY,44,15)
69 D SET($P(VAIP(17,1),"^",2),.IBY,60,20)
70 D SETVALM(.VALMCNT,.IBY)
71 ;
72 D SET("Ward Location:",.IBY,4,14)
73 D SET($P(VAIP(5),"^",2),.IBY,19,19)
74 D SET("Treating Specialty:",.IBY,40,19)
75 D SET($P(VAIP(8),"^",2),.IBY,60,20)
76 D SETVALM(.VALMCNT,.IBY)
77 ;
78 D SET("DRG:",.IBY,14,4)
79 D SET($$EX^IBATUTL(351.61,1.01,$P(IBDRG,"^")),.IBY,19,19)
80 D SET("DRG Charge:",.IBY,48,11)
81 D SET($FN($P(IBDRG,"^",2),"",2),.IBY,60,20)
82 D SETVALM(.VALMCNT,.IBY)
83 ;
84 D SET("Inpatient LOS:",.IBY,4,14)
85 D SET(+$P(IBDRG,"^",3),.IBY,19,19)
86 D SET("High Trim Days:",.IBY,44,15)
87 D SET(+$P(IBDRG,"^",4),.IBY,60,20)
88 D SETVALM(.VALMCNT,.IBY)
89 ;
90 D SET("Outlier Days:",.IBY,5,13)
91 D SET(+$P(IBDRG,"^",5),.IBY,19,19)
92 D SET("Outlier Rate:",.IBY,46,13)
93 D SET($FN($P(IBDRG,"^",6),"",2),.IBY,60,20)
94 D SETVALM(.VALMCNT,.IBY)
95 Q
96OUT ; -- detail display for outpatient
97 N IBX,IBDXLIST,IBSCE,IBPROV,IBDATE
98 ;
99 D GETGEN^SDOE($P($P(IBDATA(0),"^",12),";"),"IBSCE")
100 D GETPRV^SDOE($P($P(IBDATA(0),"^",12),";"),"IBPROV")
101 ;
102 D GETDX^SDOE($P($P(IBDATA(0),"^",12),";"),"IBDXLIST")
103 S IBDATE=$P($G(IBDATA(0)),U,4) ; Event date
104 D DX(.IBDXLIST,IBDATE)
105 ;
106 D SET("Procedure Information:",.IBY,1,22)
107 D SETVALM(.VALMCNT,.IBY)
108 D CNTRL^VALM10(VALMCNT,1,22,IOINHI,IOINORM)
109 ;
110 S IBX=0 F S IBX=$O(^IBAT(351.61,IBIEN,3,IBX)) Q:IBX<1 D
111 . S IBX(0)=$G(^IBAT(351.61,IBIEN,3,IBX,0))
112 . S IBX(1)=$$PROC^IBATUTL($P(IBX(0),U),IBDATE)
113 . ;
114 . D SET(+IBX(1),.IBY,5,6)
115 . D SET("-",.IBY,13,1)
116 . D SET($P(IBX(1),"^",2),.IBY,15,40)
117 . D SET(+$P(IBX(0),"^",2),.IBY,57,3)
118 . D SET("x",.IBY,62,1)
119 . D SET($FN($P(IBX(0),"^",3),"",2),.IBY,64,15)
120 . D SETVALM(.VALMCNT,.IBY)
121 D SETVALM(.VALMCNT,"")
122 ;
123 D SET("Visit Information:",.IBY,1,18)
124 D SETVALM(.VALMCNT,.IBY)
125 D CNTRL^VALM10(VALMCNT,1,22,IOINHI,IOINORM)
126 ;
127 D SET("Location:",.IBY,8,14)
128 D SET($P(^SC(+$P(IBSCE(0),"^",4),0),"^"),.IBY,19,46) ; dbia 10040
129 D SETVALM(.VALMCNT,.IBY)
130 ;
131 D SETVALM(.VALMCNT,"")
132 D SET("Provider(s):",.IBY,5,17)
133 S IBX=0 F S IBX=$O(IBPROV(IBX)) Q:IBX<.5 D
134 . D SET($$GET1^DIQ(200,+IBPROV(IBX),.01),.IBY,19,49) ; dbia 10060
135 . D SETVALM(.VALMCNT,.IBY)
136 ;
137 Q
138RX ; -- detail display for rx
139 D SET("Drug:",.IBY,5,5)
140 D ZERO^IBRXUTL(+IBDATA(4))
141 D SET(^TMP($J,"IBDRUG",+IBDATA(4),.01),.IBY,12,40) ; dbia 4533
142 D SET(+$P(IBDATA(4),"^",2),.IBY,55,3)
143 D SET("x",.IBY,60,1)
144 D SET($FN($P(IBDATA(4),"^",3),"",3),.IBY,62,15)
145 D SETVALM(.VALMCNT,.IBY)
146 D SETVALM(.VALMCNT,"")
147 K ^TMP($J,"IBDRUG")
148 Q
149RMPR ; -- detail display for prosthetic
150 D SETVALM(.VALMCNT,"")
151 D SET("Prosthetic Item:",.IBY,5,16)
152 D SET($P($$PIN^IBATUTL(+$P(IBDATA(0),"^",12)),U,2),.IBY,23,30) ; dbia 374
153 D SET($FN($P(IBDATA(4),"^",5),",",2),.IBY,58,15)
154 D SETVALM(.VALMCNT,.IBY)
155 D SETVALM(.VALMCNT,"")
156 Q
157DX(IBDX,IBDATE) ; -- diagnosis info
158 N IBX
159 ;
160 D SETVALM(.VALMCNT,"")
161 D SET("Diagnosis Information:",.IBY,1,22)
162 D SETVALM(.VALMCNT,.IBY)
163 D CNTRL^VALM10(VALMCNT,1,22,IOINHI,IOINORM)
164 ;
165 S IBX=0 F S IBX=$O(IBDX(IBX)) Q:IBX<1 D
166 . S IBX(0)=$$ICD9^IBACSV(+IBDX(IBX),$G(IBDATE))
167 . ;
168 . D SET($P(IBX(0),"^"),.IBY,5,7)
169 . D SET("-",.IBY,14,1)
170 . D SET($P(IBX(0),"^",3),.IBY,16,30)
171 . D SETVALM(.VALMCNT,.IBY)
172 D SETVALM(.VALMCNT,"")
173 Q
174SET(TEXT,STRING,COL,LENGTH) ; -- set up string with valm1
175 S STRING=$$SETSTR^VALM1($$LOWER^VALM1(TEXT),STRING,COL,LENGTH)
176 Q
177SETVALM(LINE,TEXT) ; -- sets line for display
178 S LINE=LINE+1
179 S ^TMP("IBATEE",$J,LINE,0)=TEXT
180 S TEXT=""
181 Q
182DATE(X) ; -- returns date for display
183 Q $$FMTE^XLFDT(X,"5D")
Note: See TracBrowser for help on using the repository browser.