source: WorldVistAEHR/trunk/r/FEE_BASIS-FB/FBFHLD3.m@ 1796

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

initial load of WorldVistAEHR

File size: 4.9 KB
Line 
1FBFHLD3 ;OIFO/SAB-GET DATA FOR OUT/ANC INVOICE ;9/9/2003
2 ;;3.5;FEE BASIS;**61**;JULY 18, 2003
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6EN ;
7 ; input
8 ; FBAAIN - invoice number
9 ; output
10 ; If transaction type = "X" then only * items are output
11 ; Claim Level Data
12 ; FBD(0,"AMT") = Amount Disbursed^Amount Interest
13 ; *FBD(0,"CAN") = Cancel Date^Cancel Reason^Cancel Activity
14 ; FBD(0,"DT") = Invoice Date
15 ; *FBD(0,"FPPS") = FPPS Claim ID
16 ; *FBD(0,"INV") = Invoice #^Transaction Type^Station #
17 ;
18 ; Line Level Data (# is a sequential number)
19 ; FBD(#,"ADJ") = AdjReason1^AdjGrp1^AdjAmt1^AdjReason2^AdjGrp2^AdjAmt2
20 ; FBD(#,"AMT") = Amount Claimed^Amount Paid
21 ; FBD(#,"CK") = Check Number^Check Date^Payment Method
22 ; FBD(#,"DT") = Date of Service
23 ; FBD(#,"FPPS") = FPPS Line Item
24 ; FBD(#,"RMK") = Remittance Remark1,Remittance Remark2
25 ; FBD(#,"SVC") = Service Code^Qualifier^Mod1,Mod2,Mod3,Mod4^Units
26 ;
27 ; If exceptions for invoice
28 ; ^TMP($J,"FBE",FBAAIN,seq number)=message
29 ; If warnings for invoice
30 ; ^TMP($J,"FBW",FBAAIN,seq number)=message
31 ;
32 ; initialize variables
33 N DA,FBC,FBI,FBIENS,FBSTA,FBTTYP,FBY
34 K FBD
35 S FBC=0 ; line count
36 ;
37 ; loop thru lines on invoice
38 S DA(3)=0
39 F S DA(3)=$O(^FBAAC("C",FBAAIN,DA(3))) Q:'DA(3) D
40 .S DA(2)=0
41 .F S DA(2)=$O(^FBAAC("C",FBAAIN,DA(3),DA(2))) Q:'DA(2) D
42 ..S DA(1)=0
43 ..F S DA(1)=$O(^FBAAC("C",FBAAIN,DA(3),DA(2),DA(1))) Q:'DA(1) D
44 ...S DA=0
45 ...F S DA=$O(^FBAAC("C",FBAAIN,DA(3),DA(2),DA(1),DA)) Q:'DA D
46 ....S FBIENS=DA_","_DA(1)_","_DA(2)_","_DA(3)_","
47 ....F FBI=0,2,3,"FBREJ" S FBY(FBI)=$G(^FBAAC(DA(3),1,DA(2),1,DA(1),1,DA,FBI))
48 ....Q:'$$CKLNST() ; skip line if status not OK to transmit
49 ....S FBC=FBC+1
50 ....; if 1st line then get invoice level data
51 ....I FBC=1 D INVOICE
52 ....I FBTTYP="L" D LINE
53 Q
54 ;
55INVOICE ; determine invoice data from 1st line item
56 ; FBD(0,"AMT") = Amount Disbursed^Amount Interest
57 ; FBD(0,"CAN") = Cancel Date^Cancel Reason^Cancel Activity
58 ; FBD(0,"DT") = Invoice Date
59 ; FBD(0,"FPPS") = FPPS Claim ID
60 ; FBD(0,"INV") = Invoice #^Transaction Type^Station #
61 ; FBSTA = station number
62 ; FBTTYP = transaction type (L or X)
63 ;
64 N FBDT,FBOB,FBX
65 ; determine Transaction Type (based on CANCELLATION DATE)
66 S FBTTYP=$S($P(FBY(2),U,4)]"":"X",1:"L")
67 ;
68 ; determine station number
69 S FBSTA=$$STANO^FBFHLU($P(FBY(0),U,8))
70 ;
71 ;INV
72 S FBD(0,"INV")=FBAAIN_U_FBTTYP_U_FBSTA
73 ;
74 ;FPPS
75 S FBD(0,"FPPS")=$P(FBY(3),U)
76 ;
77 ;CAN
78 ; if cancel then get cancel data
79 I FBTTYP="X" D Q
80 . S FBD(0,"CAN")=$P(FBY(2),U,4)_U_$$GET1^DIQ(162.03,FBIENS,"37:1")_U_$P(FBY(2),U,6)
81 ;
82 ;AMT
83 S FBD(0,"AMT")="0^0" ; initialize sums
84 ;
85 ;DT
86 ; determine invoice date
87 ; (date finalized or date paid or date supervisor closed batch)
88 S FBDT=$P(FBY(0),U,6) ; date finalized
89 I FBDT="" S FBDT=$P(FBY(0),U,14) ; date paid
90 I FBDT="",$P(FBY(0),U,8) S FBDT=$P(^FBAA(161.7,$P(FBY(0),U,8),0),U,6) ; date supv closed batch (for 0.00 invoices)
91 S FBD(0,"DT")=FBDT
92 ;
93 Q
94 ;
95LINE ; FBC
96 ; FBD(#,"ADJ") = AdjReason1^AdjGrp1^AdjAmt1^AdjReason2^AdjGrp2^AdjAmt2
97 ; FBD(#,"AMT") = Amount Claimed^Amount Paid
98 ; FBD(#,"CK") = Check Number^Check Date^Payment Method
99 ; FBD(#,"DT") = Date of Service
100 ; FBD(#,"FPPS") = FPPS Line Item
101 ; FBD(#,"RMK") = Remittance Remark1^Remittance Remark2
102 ; FBD(#,"SVC") = Service Code^Qualifier^Mod1,Mod2,Mod3,Mod4^Units
103 ;
104 N FBAARCE,FBADJ,FBMODLE
105 ; compare invoice transaction type (L,X) with line cancel status
106 I ((FBTTYP="X")&($P(FBY(2),U,4)=""))!((FBTTYP="L")&($P(FBY(2),U,4)]"")) D POST^FBFHLU(FBAAIN,"E","ALL LINES DO NOT HAVE SAME CANCEL STATUS") Q
107 ;
108 ; SVC
109 S FBAARCE=$$GET1^DIQ(162.03,FBIENS,48)
110 I FBAARCE]"" S FBD(FBC,"SVC")=FBAARCE_U_"NU"
111 E D
112 . S FBD(FBC,"SVC")=$$GET1^DIQ(162.03,FBIENS,.01)_U_"HC"
113 . S FBMODLE=$$MODL^FBAAUTL4("^FBAAC("_DA(3)_",1,"_DA(2)_",1,"_DA(1)_",1,"_DA_",""M"")","E")
114 . I $L(FBMODLE,",")>4 S FBMODLE=$P(FBMODLE,",",1,4)
115 . S $P(FBD(FBC,"SVC"),U,3)=FBMODLE
116 S $P(FBD(FBC,"SVC"),U,4)=$P(FBY(2),U,14) ; units paid
117 ;
118 ;FPPS
119 S FBD(FBC,"FPPS")=$P(FBY(3),U,2)
120 ;
121 ;DT
122 S FBD(FBC,"DT")=$P($G(^FBAAC(DA(3),1,DA(2),1,DA(1),0)),U)
123 ;
124 ;AMT
125 S FBD(FBC,"AMT")=$P(FBY(0),U,2)_U_$P(FBY(0),U,3)
126 ;
127 ;ADJ
128 D LOADADJ^FBAAFA(FBIENS,.FBADJ)
129 I $D(FBADJ) S FBD(FBC,"ADJ")=$$ADJL^FBUTL2(.FBADJ)
130 ;
131 ;RMK
132 S FBD(FBC,"RMK")=$$RRL^FBAAFR(FBIENS)
133 ;
134 ;CK
135 S FBD(FBC,"CK")=$P(FBY(2),U,3)_U_$P(FBY(0),U,14)_U_$$PAYMETH^FBFHLU($P(FBY(2),U,3))
136 ;
137 ;CAMT ; add disbursed and interest amounts to claim (0) level
138 ; note - disbursed amount on file includes the interest
139 ; since FPPS wants it w/o interest - interest is subtracted
140 S $P(FBD(0,"AMT"),U)=$P(FBD(0,"AMT"),U)+($P(FBY(2),U,8)-$P(FBY(2),U,9))
141 S $P(FBD(0,"AMT"),U,2)=$P(FBD(0,"AMT"),U,2)+$P(FBY(2),U,9)
142 Q
143 ;
144CKLNST() ; check line status extrinsic function
145 ; result (0 or 1)
146 ; 0 when line should not be sent to FPPS
147 ; 1 when line should be sent to FPPS
148 N FBRET
149 S FBRET=1
150 ;
151 ; check if rejected line
152 I $P(FBY("FBREJ"),U)]"" S FBRET=0
153 ;
154 Q FBRET
155 ;
156 ;FBFHLD3
Note: See TracBrowser for help on using the repository browser.