source: FOIAVistA/trunk/r/FEE_BASIS-FB/FBFHLD5.m@ 761

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

initial load of FOIAVistA 6/30/08 version

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