source: WorldVistAEHR/trunk/r/FEE_BASIS-FB/FBUCLET2.m@ 1604

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

initial load of WorldVistAEHR
File size: 8.2 KB
Line 
1FBUCLET2 ;WOIFO/SAB - UNAUTHORIZED CLAIM LETTER (continued) ;08/15/02
2 ;;3.5;FEE BASIS;**38,46,69**;JAN 30, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5AUTHPR ;print authorized dates and approved amounts on disposition letter
6 ;INPUT: FBDA = ien of unauthorized claim, file 162.7
7 ; FBORDER = (optional) order number of status
8 ; FBUCA = current (after) zero node of unauthorized claim (162.7)
9 ; FBUC = unauthorized claim node in parameter file
10 ; FBCC = flag, true if CC address should print at bottom of page
11 ; FBCCI = # used to determine where CC address prints
12 ;OUTPUT: FBTAMT = total amount approved
13 ; FBCC value may be changed
14 N DA,FBAMT,FBCPT,FBDOS,FBFILE,FBIENS,FBMOD,FBMODLE,FBSC,FBSCA
15 N FBSCCOL,FBUCPAY,FBX,FBY,FBACRR,FBADJLR,FBFPPSC,FBSCID,FBFPPSL,FBJ
16 ;
17 ; get list of payments for the claim
18 S FBX=$$PAYST^FBUCUTL(FBDA,"FBUCPAY")
19 ; get fpps claim id
20 S FBFPPSC=$P($G(^FB583(FBDA,5)),U)
21 S FBSCID=""
22 ;
23 ; loop thru payments to get total amount approved and suspend code list
24 S FBTAMT=0
25 F FBFILE=162.03,162.11,162.5 D
26 . S FBIENS="" F S FBIENS=$O(FBUCPAY(FBDA,FBFILE,FBIENS)) Q:FBIENS="" D
27 . . I FBFILE=162.03 D
28 . . . S FBAMT=$$GET1^DIQ(FBFILE,FBIENS,2)
29 . . . Q:FBSCID]""
30 . . . S FBSCID=$$GET1^DIQ(FBFILE,FBIENS,49)
31 . . I FBFILE=162.11 D
32 . . . S FBAMT=$$GET1^DIQ(FBFILE,FBIENS,6.5)
33 . . I FBFILE=162.5 D
34 . . . S FBAMT=$$GET1^DIQ(FBFILE,FBIENS,8)
35 . . . Q:FBSCID]""
36 . . . S FBSCID=$$GET1^DIQ(FBFILE,FBIENS,55) ; patient control number
37 . . S FBTAMT=FBTAMT+FBAMT
38 ;
39 ; print authorized dates and total amount
40 I $Y+$S(FBCC:FBCCI,1:8)>IOSL D PAGE^FBUCLET1
41 W !?8,"Authorized from: ",$$FMTE^XLFDT($P(FBUCA,U,13))
42 W " Authorized to: ",$$FMTE^XLFDT($P(FBUCA,U,14))
43 W !?8,"Amount approved: " W:FBTAMT "$",$FN(FBTAMT,",",2)
44 W " Itemized list follows:"
45 ;
46 ; print header and detail lines for civil hospital payments
47 I $D(FBUCPAY(FBDA,162.5)) D
48 . I $Y+$S(FBCC:FBCCI,1:7)>IOSL D PAGE^FBUCLET1
49 . W !!?8,"Patient Control Number: ",FBSCID
50 . I $Y+$S(FBCC:FBCCI,1:11)>IOSL D PAGE^FBUCLET1
51 . D CHDHD
52 . S FBIENS=""
53 . F S FBIENS=$O(FBUCPAY(FBDA,162.5,FBIENS)) Q:FBIENS="" D CHD
54 ;
55 ; print header and detail lines for outpatient/ancillary payments
56 I $D(FBUCPAY(FBDA,162.03)) D
57 . I $Y+$S(FBCC:FBCCI,1:7)>IOSL D PAGE^FBUCLET1
58 . W !!?8,"Patient Account Number: ",FBSCID
59 . I $Y+$S(FBCC:FBCCI,1:11)>IOSL D PAGE^FBUCLET1
60 . D ODHD
61 . S FBIENS=""
62 . F S FBIENS=$O(FBUCPAY(FBDA,162.03,FBIENS)) Q:FBIENS="" D OD
63 ;
64 ; print header and detail lines for pharmacy payments
65 I $D(FBUCPAY(FBDA,162.11)) D
66 . I $Y+$S(FBCC:FBCCI,1:11)>IOSL D PAGE^FBUCLET1
67 . D PDHD
68 . S FBIENS=""
69 . F S FBIENS=$O(FBUCPAY(FBDA,162.11,FBIENS)) Q:FBIENS="" D PD
70 ;
71 ;set FBSCCOL flag to indicate if the suspend code column should be used
72 ; = 1 or 0 (1 if there are any suspend codes beside "4 Other")
73 S FBSCCOL=0
74 S FBSC="" F S FBSC=$O(FBSCA(FBSC)) Q:FBSC="" I FBSC'=4 S FBSCCOL=1 Q
75 ;
76 ; print relevant suspend code descriptions
77 I FBSCCOL D
78 . N FBGL,FBLBL
79 . I $Y+$S(FBCC:FBCCI,1:10)>IOSL D PAGE^FBUCLET1
80 . W !!?8,"*Reason(s) for Suspension"
81 . S FBSC="" F S FBSC=$O(FBSCA(FBSC)) Q:FBSC="" D
82 . . I FBSC="4" D Q
83 . . . W !?8,"(4) Other. Specific reason immediately follows item."
84 . . ; print description of suspend code from file when not "Other"
85 . . S FBGL="^FBAA(161.27,"
86 . . S FBLBL="("_FBSC_") "
87 . . S DA=$O(^FBAA(161.27,"B",FBSC,0))
88 . . I $Y+$S(FBCC:FBCCI,1:9)>IOSL D PAGE^FBUCLET1
89 . . D TXT^FBUCUTL2(FBGL,DA,1,"WC69I8",1,1,.FBCC,FBCCI,FBLBL)
90 ;
91 W !
92 D ACT:$D(FBACRR) K FBACRR
93 Q
94 ;
95ACT ; print table of adjustment reason descriptions
96 ; Input
97 ; FBACRR( - required, array
98 ; FBACRR(FBADJRE)=""
99 ; where FBADJRE = adjustment reason code, external value
100 N FBADJRE,FBI,X,FBACT
101 I $Y+$S(FBCC:FBCCI,1:10)>IOSL D PAGE^FBUCLET1
102 W !,?8,"*Adjustment Code Text:"
103 S FBADJRE="" F S FBADJRE=$O(FBACRR(FBADJRE)) Q:FBADJRE="" D
104 . ; get description of code in FBACT
105 . I $$AR^FBUTL1(,FBADJRE,,"FBACT")<0 Q ; quit if error
106 . ; print code and description
107 . K ^UTILITY($J,"W")
108 . S DIWL=1,DIWF="WC79I8"
109 . ; include code in output
110 . I $Y+$S(FBCC:FBCCI,1:9)>IOSL D PAGE^FBUCLET1
111 . S X=$$LJ^XLFSTR("("_FBADJRE_")",6," ") D ^DIWP
112 . S DIWF="WC79I14"
113 . ; include description in output
114 . S FBI=0 F S FBI=$O(FBACT(FBI)) Q:FBI="" S X=FBACT(FBI) I X]"" D ^DIWP
115 . D ^DIWW
116 Q
117 ;
118CHDHD ; civil hospital payment detail header
119 W !!?8,"Admission Date",?24,"Discharge Date"
120 W ?40,"Amt Claimed",?53,"Amt Approved"
121 W ?67,"Adj Code*"
122 W !?8,"--------------",?24,"--------------"
123 W ?40,"-----------",?53,"------------"
124 W ?67,"--------"
125 Q
126CHD ; civil hospital payment detail
127 S FBSC=""
128 S DA=$P(FBIENS,",")
129 S FBY=$G(^FBAAI(DA,0))
130 S FBFPPSL=$P($G(^FBAAI(DA,3)),U,2) ; fpps line item
131 S FBADJLR=$P($$ADJLRA^FBCHFA(DA_","),U)
132 S:FBADJLR]"" FBACRR(FBADJLR)=""
133 I $Y+$S(FBCC:FBCCI,1:10)>IOSL D PAGE^FBUCLET1,CHDHD
134 W !!?8,$$FMTE^XLFDT($P(FBY,U,6)),?24,$$FMTE^XLFDT($P(FBY,U,7))
135 W ?40,$J("$"_$FN($P(FBY,U,8),",",2),11)
136 W ?53,$J("$"_$FN($P(FBY,U,9),",",2),12)
137 S:FBADJLR="" FBSC=$$GET1^DIQ(162.5,FBIENS,10)
138 S:FBSC]"" FBSCA(FBSC)=""
139 W ?70,$S(FBADJLR]"":FBADJLR,1:FBSC)
140 I FBFPPSC]"" W !,?8,"FPPS Claim ID: ",FBFPPSC,?36,"FPPS Line Item: ",FBFPPSL
141 ; if "Other" suspend code then print description
142 I FBSC="4" D
143 . N FBGL,FBLBL
144 . S FBGL="^FBAAI("
145 . S FBLBL="Reason for Suspension: "
146 . D:$Y+$S(FBCC:FBCCI,1:9)>IOSL PAGE^FBUCLET1
147 . D TXT^FBUCUTL2(FBGL,DA,1,"WC69I10",1,1,.FBCC,FBCCI,FBLBL)
148 Q
149ODHD ; outpatient/ancillary payment header
150 W !!?8,"Service Date",?22,"CPT-MOD"
151 W ?40,"Amt Claimed",?53,"Amt Approved"
152 W ?67,"Adj Code*"
153 W !?8,"------------",?22,"--------"
154 W ?40,"-----------",?53,"------------"
155 W ?67,"--------"
156 Q
157 ;
158OD ; outpatient/ancillary payment detail
159 N FBADJRE
160 S FBSC=""
161 S DA=$P(FBIENS,",")
162 S DA(1)=$P(FBIENS,",",2)
163 S DA(2)=$P(FBIENS,",",3)
164 S DA(3)=$P(FBIENS,",",4)
165 S FBY=$G(^FBAAC(DA(3),1,DA(2),1,DA(1),1,DA,0))
166 S FBFPPSL=$P($G(^FBAAC(DA(3),1,DA(2),1,DA(1),1,DA,3)),U,2)
167 S FBADJLR=$P($$ADJLRA^FBAAFA(DA_","_DA(1)_","_DA(2)_","_DA(3)_","),U)
168 F FBJ=1:1 S FBADJRE=$P(FBADJLR,",",FBJ) Q:FBADJRE="" S FBACRR(FBADJRE)=""
169 S FBDOS=$P($G(^FBAAC(DA(3),1,DA(2),1,DA(1),0)),U)
170 S FBCPT=$$GET1^DIQ(162.03,FBIENS,.01)
171 S FBMODLE=$$MODL^FBAAUTL4("^FBAAC("_DA(3)_",1,"_DA(2)_",1,"_DA(1)_",1,"_DA_",""M"")","E")
172 I $Y+$S(FBCC:FBCCI,1:10)>IOSL D PAGE^FBUCLET1,ODHD
173 W !!?8,$$FMTE^XLFDT(FBDOS)
174 W ?22,FBCPT_$S($G(FBMODLE)]"":"-"_$P(FBMODLE,","),1:"")
175 W ?40,$J("$"_$FN($P(FBY,U,2),",",2),11)
176 W ?53,$J("$"_$FN($P(FBY,U,3),",",2),12)
177 S:FBADJLR="" FBSC=$$GET1^DIQ(162.03,FBIENS,4)
178 S:FBSC]"" FBSCA(FBSC)=""
179 W ?70,$S(FBADJLR]"":FBADJLR,1:FBSC)
180 I $P($G(FBMODLE),",",2)]"" D
181 . N FBI
182 . F FBI=2:1 S FBMOD=$P(FBMODLE,",",FBI) Q:FBMOD="" D
183 . . ;I $Y+4>IOSL W @IOF D HED W !," (continued)"
184 . . W !,?27,"-",FBMOD
185 I FBFPPSC]"" W !,?8,"FPPS Claim ID: ",FBFPPSC,?36,"FPPS Line Item: ",FBFPPSL
186 ; if "Other" suspend code then print description
187 I FBSC="4" D
188 . N FBGL,FBLBL
189 . S FBGL="^FBAAC("_DA(3)_",1,"_DA(2)_",1,"_DA(1)_",1,"
190 . S FBLBL="Reason for Suspension: "
191 . D:$Y+$S(FBCC:FBCCI,1:9)>IOSL PAGE^FBUCLET1
192 . D TXT^FBUCUTL2(FBGL,DA,1,"WC69I10",1,1,.FBCC,FBCCI,FBLBL)
193 Q
194PDHD ; pharmacy payment detail header
195 W !!?8,"RX Date",?21,"RX #"
196 W ?40,"Amt Claimed",?53,"Amt Approved"
197 W ?67,"Adj Code*"
198 W !?8,"------------",?21,"--------"
199 W ?40,"-----------",?53,"------------"
200 W ?67,"--------"
201 Q
202PD ; pharmacy payment detail
203 N FBADJRE
204 S FBSC=""
205 S DA=$P(FBIENS,",")
206 S DA(1)=$P(FBIENS,",",2)
207 S FBY=$G(^FBAA(162.1,DA(1),"RX",DA,0))
208 S FBFPPSL=$P($G(^FBAA(162.1,DA(1),"RX",DA,3)),U)
209 S FBADJLR=$P($$ADJLRA^FBRXFA(DA_","_DA(1)_","),U)
210 F FBJ=1:1 S FBADJRE=$P(FBADJLR,",",FBJ) Q:FBADJRE="" S FBACRR(FBADJRE)=""
211 I $Y+$S(FBCC:FBCCI,1:11)>IOSL D PAGE^FBUCLET1,PDHD
212 W !!?8,$$FMTE^XLFDT($P(FBY,U,3)),?21,$$FMTE^XLFDT($P(FBY,U,1))
213 W ?40,$J("$"_$FN($P(FBY,U,4),",",2),11)
214 W ?53,$J("$"_$FN($P(FBY,U,16),",",2),12)
215 S:FBADJLR="" FBSC=$$GET1^DIQ(162.11,FBIENS,7)
216 S:FBSC]"" FBSCA(FBSC)=""
217 W ?70,$S(FBADJLR]"":FBADJLR,1:FBSC)
218 W !?8,"Drug Name: ",$P(FBY,U,2)
219 I FBFPPSC]"" W !,?8,"FPPS Claim ID: ",FBFPPSC,?36,"FPPS Line Item: ",FBFPPSL
220 ; if "Other" suspend code then print description
221 I FBSC="4" D
222 . N FBGL,FBLBL
223 . S FBGL="^FBAA(162.1,"_DA(1)_",""RX"","
224 . S FBLBL="Reason for Suspension: "
225 . D:$Y+$S(FBCC:FBCCI,1:8)>IOSL PAGE^FBUCLET1
226 . D TXT^FBUCUTL2(FBGL,DA,1,"WC69I10",1,1,.FBCC,FBCCI,FBLBL)
227 Q
Note: See TracBrowser for help on using the repository browser.