source: WorldVistAEHR/trunk/r/FEE_BASIS-FB/FBFHLS.m@ 1638

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

initial load of WorldVistAEHR
File size: 8.3 KB
Line 
1FBFHLS ;OIFO/SAB-BUILD HL7 MESSAGE SEGMENTS ;11/21/2003
2 ;;3.5;FEE BASIS;**61,68**;JAN 30, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6EN ;
7 ; input
8 ; HLFS - HL7 field separator
9 ; HLECH - HL7 encoding characters
10 ; FBAAIN - invoice number
11 ; FBD( array containing the invoice data
12 ; Applicablity of a FBD node for a given transaction type (C,L, or X)
13 ; is indicated by the presence of the transaction type code at the
14 ; beginning of the line in the following table.
15 ;
16 ; Claim Level Data
17 ; CL FBD(0,"AMT") = Amount Disbursed^Amount Interest
18 ; X FBD(0,"CAN") = Cancel Date^Cancel Reason^Cancel Activity
19 ; C FBD(0,"DAYS") = Covered Days
20 ; C FBD(0,"DRG") = DRG Code^DRG Weight
21 ; CL FBD(0,"DT") = Invoice Date
22 ; CLX FBD(0,"FPPS") = FPPS Claim ID
23 ; CLX FBD(0,"INV") = Invoice #^Transaction Type^Station #
24 ;
25 ; Line Level Data (# is a sequential number)
26 ; CL FBD(#,"ADJ") = AdjReas1^AdjGrp1^AdjAmt1^AdjReas2^AdjGrp2^AdjAmt2
27 ; note: ADJ node is only defined when there is an adjustment
28 ; note: only 1 adjustment for C type
29 ; CL FBD(#,"AMT") = Amount Claimed^Amount Paid
30 ; CL FBD(#,"CK") = Check Number^Check Date^Payment Method
31 ; CL FBD(#,"DT") = Date of Service/Start Date^End Date
32 ; note: End Date only applicable for C type
33 ; CL FBD(#,"FPPS") = FPPS Line Item
34 ; CL FBD(#,"RMK") = Remittance Remark1,Remittance Remark2
35 ; L FBD(#,"SVC") = Service Code^Qualifier^Mod1,Mod2,Mod3,Mod4^Units
36 ; note: SVC node is not defined for pharmacy invoices
37 ;
38 ; If existing exceptions for invoice
39 ; ^TMP($J,"FBE",FBAAIN,seq number)=message
40 ; If existing warnings for invoice
41 ; ^TMP($J,"FBW",FBAAIN,seq number)=message
42 ;
43 ; output
44 ; ^TMP("HLS",$J) = HL global array for invoice
45 ; If new exceptions for invoice
46 ; ^TMP($J,"FBE",FBAAIN,seq number)=message
47 ; If new warnings for invoice
48 ; ^TMP($J,"FBW",FBAAIN,seq number)=message
49 ;
50 ; initialize variables
51 N FBTTYP
52 K ^TMP("HLS",$J)
53 ;
54 ; determine transaction type
55 S FBTTYP=$P($G(FBD(0,"INV")),U,2)
56 ;
57 I '$D(HLFS) D I '$D(HLFS) Q
58 . N FBHL
59 . D INIT^HLFNC2("FB FEE TO FPPS EVENT",.FBHL)
60 . I $G(FBHL) Q
61 . S HLFS=FBHL("FS")
62 . S HLECH=FBHL("ECH")
63 ;
64 ; check for required fields
65 D CHKREQ^FBFHLS1
66 ;
67 ; quit if exceptions
68 Q:$D(^TMP($J,"FBE",FBAAIN))
69 ;
70 ; build segments for invoice in ^TMP("HLS",$J,
71 I FBTTYP="C" D CL
72 I FBTTYP="L" D CL
73 I FBTTYP="X" D X
74 ;
75 Q
76 ;
77CL ; Claim or Line Transaction
78 N FBCOMP,FBFLD,FBFT1,FBI,FBL,FBORC,FBX
79 S FBL=0 ; line counter for HL7 lines in ^TMP("HLS",$J,line
80 ; loop thru line items (Claim Transaction must have just 1 line)
81 S FBI=0 F S FBI=$O(FBD(FBI)) Q:'FBI D
82 . S FBORC="ORC"
83 . ; transaction type (005)
84 . S $P(FBORC,HLFS,6)=$P(FBD(0,"INV"),U,2)
85 . ;
86 . I FBTTYP="C" D
87 . . ; covered days (007.3)
88 . . S FBFLD=$P(FBORC,HLFS,8)
89 . . S $P(FBFLD,$E(HLECH,1),3)=$P(FBD(0,"DAYS"),U)
90 . . S $P(FBORC,HLFS,8)=FBFLD
91 . ;
92 . ; date of service/start date (007.4.1)
93 . S FBFLD=$P(FBORC,HLFS,8)
94 . S FBCOMP=$P(FBFLD,$E(HLECH,1),4)
95 . S $P(FBCOMP,$E(HLECH,2),1)=$$FMTHL7^XLFDT($P(FBD(FBI,"DT"),U))
96 . S $P(FBFLD,$E(HLECH,1),4)=FBCOMP
97 . S $P(FBORC,HLFS,8)=FBFLD
98 . ;
99 . I FBTTYP="C" D
100 . . ; end date (007.5.1)
101 . . S FBFLD=$P(FBORC,HLFS,8)
102 . . S FBCOMP=$P(FBFLD,$E(HLECH,1),5)
103 . . S $P(FBCOMP,$E(HLECH,2),1)=$$FMTHL7^XLFDT($P(FBD(FBI,"DT"),U,2))
104 . . S $P(FBFLD,$E(HLECH,1),5)=FBCOMP
105 . . S $P(FBORC,HLFS,8)=FBFLD
106 . ;
107 . ; invoice date (009.1)
108 . S FBFLD=$P(FBORC,HLFS,10)
109 . S $P(FBFLD,$E(HLECH,1),1)=$$FMTHL7^XLFDT($P(FBD(0,"DT"),U))
110 . S $P(FBORC,HLFS,10)=FBFLD
111 . ;
112 . ; station number (013.4.2)
113 . S FBFLD=$P(FBORC,HLFS,14)
114 . S FBCOMP=$P(FBFLD,$E(HLECH,1),4)
115 . S $P(FBCOMP,$E(HLECH,2),2)=$P(FBD(0,"INV"),U,3)
116 . S $P(FBFLD,$E(HLECH,1),4)=FBCOMP
117 . S $P(FBORC,HLFS,14)=FBFLD
118 . ;
119 . ; store HL ORC segment for the line item
120 . S FBX=FBORC D TMPHL
121 . ;
122 . S FBFT1="FT1"
123 . ;
124 . ; FPPS CLAIM-LINE (002)
125 . S $P(FBFT1,HLFS,3)=$P(FBD(0,"FPPS"),U)_"-"_$$EXPLIST($P(FBD(FBI,"FPPS"),U))
126 . ;
127 . ; INVOICE # (003)
128 . S $P(FBFT1,HLFS,4)=$P(FBD(0,"INV"),U)
129 . ;
130 . ; CHECK DATE (004)
131 . S $P(FBFT1,HLFS,5)=$$FMTHL7^XLFDT($P(FBD(FBI,"CK"),U,2))
132 . ;
133 . ; PAYMENT METHOD (006)
134 . S $P(FBFT1,HLFS,7)=$P(FBD(FBI,"CK"),U,3)
135 . ;
136 . I FBTTYP="L" D
137 . . ; UNITS PAID (010)
138 . . S $P(FBFT1,HLFS,11)=$P($G(FBD(FBI,"SVC")),U,4)
139 . ;
140 . ; REMITTANCE REMARKS (013)
141 . S $P(FBFT1,HLFS,14)=$P(FBD(FBI,"RMK"),U)
142 . ;
143 . I FBTTYP="L" D
144 . . ; SERVICE QUALIFIER (019)
145 . . S $P(FBFT1,HLFS,20)=$P($G(FBD(FBI,"SVC")),U,2)
146 . ;
147 . ; CHECK NUMBER (023)
148 . S $P(FBFT1,HLFS,24)=$P(FBD(FBI,"CK"),U)
149 . ;
150 . I FBTTYP="L" D
151 . . ; SERVICE PROVIDED (025)
152 . . S $P(FBFT1,HLFS,26)=$P($G(FBD(FBI,"SVC")),U)
153 . ;
154 . I FBTTYP="C" D
155 . . ; DRG (025)
156 . . S $P(FBFT1,HLFS,26)=$P(FBD(0,"DRG"),U)
157 . ;
158 . I FBTTYP="L" D
159 . . ; MODIFIERS (026)
160 . . S $P(FBFT1,HLFS,27)=$P($G(FBD(FBI,"SVC")),U,3)
161 . ;
162 . I FBTTYP="C" D
163 . . ; DRG WEIGHT (026)
164 . . S $P(FBFT1,HLFS,27)=$P(FBD(0,"DRG"),U,2)
165 . ;
166 . ; generate and store FT1s for each of the different $ amounts
167 . ; amount claimed
168 . S FBX=$$FT1(1,$P(FBD(FBI,"AMT"),U)) D TMPHL
169 . ; amount paid
170 . S FBX=$$FT1(2,$P(FBD(FBI,"AMT"),U,2)) D TMPHL
171 . ; interest amount (conditional)
172 . I $P(FBD(0,"AMT"),U,2)>0 S FBX=$$FT1(3,$P(FBD(0,"AMT"),U,2)) D TMPHL
173 . ; disbursed amount
174 . S FBX=$$FT1(4,$P(FBD(0,"AMT"),U)) D TMPHL
175 . ; adjustment amount 1 (conditional)
176 . I +$P($G(FBD(FBI,"ADJ")),U,3)'=0 S FBX=$$FT1(5,$P(FBD(FBI,"ADJ"),U,1,3)) D TMPHL
177 . I FBTTYP="L" D
178 . . ; adjustment amount 2 (conditional)
179 . . I +$P($G(FBD(FBI,"ADJ")),U,6)'=0 S FBX=$$FT1(5,$P(FBD(FBI,"ADJ"),U,4,6)) D TMPHL
180 ;
181 Q
182 ;
183X ; Cancel Transaction
184 N FBCOMP,FBFLD,FBFT1,FBL,FBORC
185 S FBL=0 ; line counter for HL7 lines in ^TMP("HLS",$J,line
186 S FBORC="ORC"
187 ; transaction type (005)
188 S $P(FBORC,HLFS,6)=$P(FBD(0,"INV"),U,2)
189 ;
190 ; cancel date (009.1)
191 S FBFLD=$P(FBORC,HLFS,10)
192 S $P(FBFLD,$E(HLECH,1),1)=$$FMTHL7^XLFDT($P(FBD(0,"CAN"),U))
193 S $P(FBORC,HLFS,10)=FBFLD
194 ;
195 ; station number (013.4.2)
196 S FBFLD=$P(FBORC,HLFS,14)
197 S FBCOMP=$P(FBFLD,$E(HLECH,1),4)
198 S $P(FBCOMP,$E(HLECH,2),2)=$P(FBD(0,"INV"),U,3)
199 S $P(FBFLD,$E(HLECH,1),4)=FBCOMP
200 S $P(FBORC,HLFS,14)=FBFLD
201 ;
202 S FBFT1="FT1"
203 ;
204 ; FPPS CLAIM (002)
205 S $P(FBFT1,HLFS,3)=$P(FBD(0,"FPPS"),U)
206 ;
207 ; INVOICE # (003)
208 S $P(FBFT1,HLFS,4)=$P(FBD(0,"INV"),U)
209 ;
210 ; CANCEL ACTIVITY CODE (006)
211 S $P(FBFT1,HLFS,7)="F"_$P(FBD(0,"CAN"),U,3)
212 ;
213 ; CANCEL REASON (017)
214 S $P(FBFT1,HLFS,18)=$P(FBD(0,"CAN"),U,2)
215 ;
216 ; store HL segments for line item
217 S FBX=FBORC D TMPHL
218 S FBX=FBFT1 D TMPHL
219 ;
220 Q
221 ;
222EXPLIST(FBLIST) ; expand ranges in a list
223 ; input FBIST - list or range or "ALL"
224 ; result expanded list (e.g. "1-3" returned as "1,2,3")
225 ;
226 N FBER,FBRET,FBLIST2,FBI,FBX,FBY
227 S FBRET=$G(FBLIST)
228 I FBRET["-" D
229 . S FBLIST2="" ; init new list
230 . ; loop thru comma pieces in original list
231 . F FBI=1:1 S FBX=$P(FBLIST,",",FBI) Q:FBX="" D
232 . . I FBX'["-" S FBLIST2=FBLIST2_FBX_"," Q ; not range - put in new
233 . . ; expand range then put in new
234 . . S FBER=""
235 . . F FBY=$P(FBX,"-"):1:$P(FBX,"-",2) S FBER=FBER_FBY_","
236 . . ; append expanded range to new list
237 . . S FBLIST2=FBLIST2_FBER
238 . ; replace return value with expanded list
239 . S FBRET=FBLIST2
240 ;
241 ; remove trailing comma
242 I $E(FBRET,$L(FBRET))="," S FBRET=$E(FBRET,1,$L(FBRET)-1)
243 ;
244 Q FBRET
245 ;
246FT1(FBTYAMT,FBX) ; add amount to FT1 segment
247 ; input
248 ; FBTYAMT - type of amount (1,2,3,4,5)
249 ; FBX - if type 1-4 then amount
250 ; - if type 5 then adj reason^adjustment group^adj amount
251 ; FBFT1 - FT1 segment without an amount
252 ; result (string)
253 ; FT1 segment with amount (and reason, group) inserted
254 N FBRET
255 S FBRET=FBFT1
256 ;
257 ; TYPE AMOUNT (007)
258 S $P(FBRET,HLFS,8)=FBTYAMT
259 ;
260 ; AMOUNT (011)
261 I FBTYAMT<5 S $P(FBRET,HLFS,12)=$FN($P(FBX,U),"",2)
262 I FBTYAMT=5 S $P(FBRET,HLFS,12)=$FN($P(FBX,U,3),"",2)
263 ;
264 ; ADJUSTMENT REASON (017)
265 I FBTYAMT=5 S $P(FBRET,HLFS,18)=$P(FBX,U)
266 ;
267 ; ADJUSTMENT GROUP (018)
268 I FBTYAMT=5 S $P(FBRET,HLFS,19)=$P(FBX,U,2)
269 ;
270 Q FBRET
271 ;
272TMPHL ; Place HL7 segment in ^TMP
273 ; input
274 ; FBL - last line written to ^TMP
275 ; FBX - HL7 segment
276 ; output
277 ; FBL - will be incremented by 1
278 ; stores FBX in ^TMP("HLS",$J,FBL+1)
279 ; if length of FBX exceeds 244 then continuation lines will be used
280 ; example ^TMP($J,"HLS",$J,FBL+1,1)
281 N FBLS
282 S FBL=FBL+1
283 I $L(FBX)<245 S ^TMP("HLS",$J,FBL)=FBX Q
284 S ^TMP("HLS",$J,FBL)=$E(FBX,1,244)
285 F FBLS=1:1 Q:$E(FBX,(FBLS*244)+1,(FBLS*244)+244)="" D
286 . S ^TMP("HLS",$J,FBL,FBLS)=$E(FBX,(FBLS*244)+1,(FBLS*244)+244)
287 Q
288 ;
289 ;FBFHLS
Note: See TracBrowser for help on using the repository browser.