| 1 | FBFHLD5 ;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 | ; | 
|---|
| 6 | EN ; | 
|---|
| 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 | ; | 
|---|
| 49 | INVOICE ; 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 | ; | 
|---|
| 89 | LINE ; 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 | ; | 
|---|
| 128 | CKLNST() ; 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 | ; | 
|---|
| 140 | RXSTA(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 | 
|---|