source: WorldVistAEHR/trunk/r/FEE_BASIS-FB/FBFHLD9.m@ 1154

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

initial load of WorldVistAEHR

File size: 3.9 KB
Line 
1FBFHLD9 ;OIFO/SAB-GET DATA FOR INPATIENT 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,"DAYS) = Covered Days
15 ; FBD(0,"DRG") = DRG^DRG Weight
16 ; FBD(0,"DT") = Invoice Date
17 ; *FBD(0,"FPPS") = FPPS Claim ID
18 ; *FBD(0,"INV") = Invoice #^Transaction Type^Station #
19 ;
20 ; Line Level Data
21 ; FBD(1,"ADJ") = AdjReason1^AdjGrp1^AdjAmt1
22 ; FBD(1,"AMT") = Amount Claimed^Amount Paid
23 ; FBD(1,"CK") = Check Number^Check Date^Payment Method
24 ; FBD(1,"DT") = Start Date^End Date
25 ; FBD(1,"FPPS") = FPPS Line Item
26 ; FBD(1,"RMK") = Remittance Remark1,Remittance Remark2
27 ;
28 ; If exceptions for invoice
29 ; ^TMP($J,"FBE",FBAAIN,seq number)=message
30 ; If warnings for invoice
31 ; ^TMP($J,"FBW",FBAAIN,seq number)=message
32 ;
33 ; initialize variables
34 N DA,FBC,FBI,FBIENS,FBSTA,FBTTYP,FBY
35 K FBD
36 ;
37 S DA=FBAAIN
38 S FBIENS=DA_","
39 F FBI=0,2,3,"FBREJ" S FBY(FBI)=$G(^FBAAI(DA,FBI))
40 Q:'$$CKLNST() ; skip line if status not OK to transmit
41 S FBC=1
42 D INVOICE
43 I FBTTYP="C" D LINE
44 Q
45 ;
46INVOICE ; determine invoice data
47 ; FBD(0,"AMT") = Amount Disbursed^Amount Interest
48 ; FBD(0,"CAN") = Cancel Date^Cancel Reason^Cancel Activity
49 ; FBD(0,"DAYS")
50 ; FBD(0,"DRG")
51 ; FBD(0,"DT") = Invoice Date
52 ; FBD(0,"FPPS") = FPPS Claim ID
53 ; FBD(0,"INV") = Invoice #^Transaction Type^Station #
54 ; FBSTA = station number
55 ; FBTTYP = transaction type (C or X)
56 ;
57 N FBDT,FBOB,FBX
58 ; determine Transaction Type (based on CANCELLATION DATE)
59 S FBTTYP=$S($P(FBY(2),U,5)]"":"X",1:"C")
60 ;
61 ; determine station number
62 S FBSTA=$$STANO^FBFHLU($P(FBY(0),U,17))
63 ;
64 ;INV
65 S FBD(0,"INV")=FBAAIN_U_FBTTYP_U_FBSTA
66 ;
67 ;FPPS
68 S FBD(0,"FPPS")=$P(FBY(3),U)
69 ;
70 ;CAN
71 ; if cancel then get cancel data
72 I FBTTYP="X" D Q
73 . S FBD(0,"CAN")=$P(FBY(2),U,5)_U_$$GET1^DIQ(162.5,FBIENS,"50:1")_U_$P(FBY(2),U,7)
74 ;
75 ;AMT
76 S FBD(0,"AMT")="0^0" ; initialize sums
77 ;
78 ;DT
79 ; determine invoice date
80 ; (date finalized or date paid or date supervisor closed batch)
81 S FBDT=$P(FBY(0),U,16) ; date finalized
82 I FBDT="" S FBDT=$P(FBY(2),U) ; date paid
83 I FBDT="",$P(FBY(0),U,17) S FBDT=$P(^FBAA(161.7,$P(FBY(0),U,17),0),U,6) ; date supv closed
84 S FBD(0,"DT")=FBDT
85 ;
86 ;DAYS
87 S FBD(0,"DAYS")=+$P(FBY(2),U,10)
88 ;
89 ;DRG
90 S FBX=$$GET1^DIQ(162.5,FBIENS,24)
91 I $E(FBX,1,3)="DRG" S FBX=$E(FBX,4,999)
92 S FBD(0,"DRG")=FBX_U_$P(FBY(2),U,12)
93 ;
94 Q
95 ;
96LINE ; FBC
97 ; FBD(#,"ADJ") = AdjReason1^AdjGrp1^AdjAmt1
98 ; FBD(#,"AMT") = Amount Claimed^Amount Paid
99 ; FBD(#,"CK") = Check Number^Check Date^Payment Method
100 ; FBD(#,"DT") = Start Date^End Date
101 ; FBD(#,"FPPS") = FPPS Line Item
102 ; FBD(#,"RMK") = Remittance Remark1^Remittance Remark2
103 ;
104 N FBADJ
105 ;
106 ;FPPS
107 S FBD(FBC,"FPPS")=$P(FBY(3),U,2)
108 ;
109 ;DT
110 S FBD(FBC,"DT")=$P(FBY(0),U,6)_U_$P(FBY(0),U,7)
111 ;
112 ;AMT
113 S FBD(FBC,"AMT")=$P(FBY(0),U,8)_U_$P(FBY(0),U,9)
114 ;
115 ;ADJ
116 D LOADADJ^FBCHFA(FBIENS,.FBADJ)
117 I $D(FBADJ) S FBD(FBC,"ADJ")=$$ADJL^FBUTL2(.FBADJ)
118 ;
119 ;RMK
120 S FBD(FBC,"RMK")=$$RRL^FBCHFR(FBIENS)
121 ;
122 ;CK
123 S FBD(FBC,"CK")=$P(FBY(2),U,4)_U_$P(FBY(2),U)_U_$$PAYMETH^FBFHLU($P(FBY(2),U,4))
124 ;
125 ;CAMT ; add disbursed and interest amounts to claim (0) level
126 ; note - disbursed amount on file includes the interest
127 ; since FPPS wants it w/o interest - interest is subtracted
128 S $P(FBD(0,"AMT"),U)=$P(FBD(0,"AMT"),U)+($P(FBY(2),U,8)-$P(FBY(2),U,9))
129 S $P(FBD(0,"AMT"),U,2)=$P(FBD(0,"AMT"),U,2)+$P(FBY(2),U,9)
130 Q
131 ;
132CKLNST() ; check line status extrinsic function
133 ; result (0 or 1)
134 ; 0 when line should not be sent to FPPS
135 ; 1 when line should be sent to FPPS
136 N FBRET
137 S FBRET=1
138 ;
139 ; check if rejected line
140 I $P(FBY("FBREJ"),U)]"" S FBRET=0
141 ;
142 Q FBRET
143 ;
144 ;FBFHLD9
Note: See TracBrowser for help on using the repository browser.