| 1 | IBCNRHLT ;DAOU/DMK - Receive HL7 e-Pharmacy MFN Message ;23-OCT-2003
|
---|
| 2 | ;;2.0;INTEGRATED BILLING;**251**;21-MAR-94
|
---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
| 4 | ;
|
---|
| 5 | ; Description
|
---|
| 6 | ;
|
---|
| 7 | ; Receive HL7 e-Pharmacy MFN Message
|
---|
| 8 | ; Table Update
|
---|
| 9 | ;
|
---|
| 10 | ; Control processing of segments
|
---|
| 11 | ;
|
---|
| 12 | ; Required segments listed in order
|
---|
| 13 | ; MSH (Message Header Segment) (processed by IBCNEHLT)
|
---|
| 14 | ; MFI (Master File Identifier Segment) (processed by IBCNEHLT)
|
---|
| 15 | ; MFE (Master File Entry Segment)
|
---|
| 16 | ;
|
---|
| 17 | ; Optional segments listed by file
|
---|
| 18 | ; ZP0 (365.12 PAYER File Update Segment)
|
---|
| 19 | ;
|
---|
| 20 | ; ZPT (366.01 NCPDP PROCESSOR File Update Segment)
|
---|
| 21 | ; ZCM (366.012 NCPDP PROCESSOR CONTACT MEANS Subfile Update Segment)
|
---|
| 22 | ;
|
---|
| 23 | ; ZPB (366.02 PHARMACY BENEFITS MANAGER (PBM) File Update Segment)
|
---|
| 24 | ; ZCM (366.022 PHARMACY BENEFITS MANAGER (PBM) CONTACT MEANS Subfile
|
---|
| 25 | ; Update Segment)
|
---|
| 26 | ;
|
---|
| 27 | ; ZPL (366.03 PLAN File Update Segment)
|
---|
| 28 | ; ZCM (366.032 PLAN CONTACT MEANS Subfile Update Segment)
|
---|
| 29 | ;
|
---|
| 30 | ; ZRX (366.03 PLAN File (Pharmacy) Update Segment)
|
---|
| 31 | ; ZCM (366.0312 PLAN RX CONTACT MEANS Subfile Update Segment)
|
---|
| 32 | ;
|
---|
| 33 | ; Called by IBCNEHLT if all of the following are true
|
---|
| 34 | ; * File # (MFI Segment) = 365.12, 366.01, 366.02, or 366.03
|
---|
| 35 | ; * Primary Key Value (MFE Segment) does not contain "IIV"
|
---|
| 36 | ; * Segment ID (every segment) = MFE, ZCM, ZP0, ZPB, ZPL, ZPT, or ZRX
|
---|
| 37 | ;
|
---|
| 38 | ; Entry point
|
---|
| 39 | ;
|
---|
| 40 | 1000 ; Control processing
|
---|
| 41 | I $D(ERROR) Q
|
---|
| 42 | D @SEG
|
---|
| 43 | ;
|
---|
| 44 | ; Initialize MFK Message (Application Acknowledgement) variables
|
---|
| 45 | I $D(ERROR) D Q
|
---|
| 46 | . S DATAMFK("ERROR")=ERROR
|
---|
| 47 | . S DATAMFK("IEN")=IEN
|
---|
| 48 | ;
|
---|
| 49 | ; Quit if more segments
|
---|
| 50 | I $O(^TMP($J,"IBCNEHLI",HCT))]"" Q
|
---|
| 51 | ;
|
---|
| 52 | ; Update File?
|
---|
| 53 | I $D(DATA) D
|
---|
| 54 | . S FIELDNO="" F S FIELDNO=$O(DATA(FIELDNO)) Q:FIELDNO="" D
|
---|
| 55 | .. ;
|
---|
| 56 | .. ; Convert "" to "@" to delete field value if necessary
|
---|
| 57 | .. I IEN'=-1,DATA(FIELDNO)="" S DATA(FIELDNO)="@"
|
---|
| 58 | .. ;
|
---|
| 59 | .. ; Convert HL7 special characters if necessary
|
---|
| 60 | .. I DATA(FIELDNO)[$E(HLECH,3) S DATA(FIELDNO)=$$TRAN1^IBCNRHLU(DATA(FIELDNO))
|
---|
| 61 | . D FILE
|
---|
| 62 | ;
|
---|
| 63 | ; Update File?
|
---|
| 64 | I $D(DATABPS) D
|
---|
| 65 | . S FIELDNO="" F S FIELDNO=$O(DATABPS(FIELDNO)) Q:FIELDNO="" D
|
---|
| 66 | .. ;
|
---|
| 67 | .. ; Convert "" to "@" to delete field value if necessary
|
---|
| 68 | .. I IEN'=-1,DATABPS(FIELDNO)="" S DATABPS(FIELDNO)="@"
|
---|
| 69 | .. ;
|
---|
| 70 | .. ; Convert HL7 special characters if necessary
|
---|
| 71 | .. I DATABPS(FIELDNO)[$E(HLECH,3) S DATABPS(FIELDNO)=$$TRAN1^IBCNRHLU(DATABPS(FIELDNO))
|
---|
| 72 | . ;
|
---|
| 73 | . D FILEBPS
|
---|
| 74 | ;
|
---|
| 75 | ; Update APPLICATION Subfile?
|
---|
| 76 | I $D(DATAAP) D
|
---|
| 77 | . S FIELDNO="" F S FIELDNO=$O(DATAAP(FIELDNO)) Q:FIELDNO="" D
|
---|
| 78 | .. ;
|
---|
| 79 | .. ; Convert "" to "@" to delete field value if necessary
|
---|
| 80 | .. I APIEN'=-1,DATAAP(FIELDNO)="" S DATAAP(FIELDNO)="@"
|
---|
| 81 | .. ;
|
---|
| 82 | .. ; Convert HL7 special characters if necessary
|
---|
| 83 | .. I DATAAP(FIELDNO)[$E(HLECH,3) S DATAAP(FIELDNO)=$$TRAN1^IBCNRHLU(DATAAP(FIELDNO))
|
---|
| 84 | . S FIELDNO=$S(FILENO=365.12:1,1:3)
|
---|
| 85 | . D FILEAP
|
---|
| 86 | ;
|
---|
| 87 | ; Update CONTACT MEANS Subfile?
|
---|
| 88 | I $D(DATACM) D
|
---|
| 89 | . S FIELDNO="" F S FIELDNO=$O(DATACM(FIELDNO)) Q:FIELDNO="" D
|
---|
| 90 | .. ;
|
---|
| 91 | .. ; Convert "" to "@" to delete field value if necessary
|
---|
| 92 | .. I CMIEN'=-1,DATACM(FIELDNO)="" S DATACM(FIELDNO)="@"
|
---|
| 93 | .. ;
|
---|
| 94 | .. ; Convert HL7 special characters if necessary
|
---|
| 95 | .. I DATACM(FIELDNO)[$E(HLECH,3) S DATACM(FIELDNO)=$$TRAN1^IBCNRHLU(DATACM(FIELDNO))
|
---|
| 96 | . S FIELDNO=$S(FILE["Pharmacy"&FILENO=366.03:12,1:2)
|
---|
| 97 | . I IBCNACT="MDL" D DELETECM Q
|
---|
| 98 | . D FILECM
|
---|
| 99 | Q
|
---|
| 100 | ;
|
---|
| 101 | ADD ; Add File entry
|
---|
| 102 | ; 365.12 PAYER File
|
---|
| 103 | ; 366.01 NCPDP PROCESSOR File
|
---|
| 104 | ; 366.02 PHARMACY BENEFITS MANAGER (PBM) File
|
---|
| 105 | ; 366.03 PLAN File
|
---|
| 106 | ;
|
---|
| 107 | S IEN=$$ADD1^IBCNRFM1(FILENO,DATA(.01))
|
---|
| 108 | Q
|
---|
| 109 | ;
|
---|
| 110 | ADDAP ; Add APPLICATION Subfile entry
|
---|
| 111 | ; 365.121 PAYER APPLICATION Subfile
|
---|
| 112 | ; 366.013 NCPDP PROCESSOR APPLICATION File
|
---|
| 113 | ; 366.023 PHARMACY BENEFITS MANAGER (PBM) APPLICATION Subfile
|
---|
| 114 | ; 366.033 PLAN APPLICATION Subfile
|
---|
| 115 | ;
|
---|
| 116 | S APIEN=$$ADD2^IBCNRFM1(FILENO,IEN,FIELDNO,AIEN)
|
---|
| 117 | Q
|
---|
| 118 | ;
|
---|
| 119 | ADDCM ; Add CONTACT MEANS Subfile entry
|
---|
| 120 | ; 366.012 NCPDP PROCESSOR CONTACT MEANS Subfile
|
---|
| 121 | ; 366.022 PHARMACY BENEFITS MANAGER (PBM) CONTACT MEANS Subfile
|
---|
| 122 | ; 366.032 PLAN CONTACT MEANS Subfile
|
---|
| 123 | ; 366.0312 PLAN RX CONTACT MEANS Subfile
|
---|
| 124 | ;
|
---|
| 125 | S CMIEN=$$ADD2^IBCNRFM1(FILENO,IEN,FIELDNO,DATACM(.01))
|
---|
| 126 | Q
|
---|
| 127 | ;
|
---|
| 128 | DELETECM ; Delete CONTACT MEANS Subfile entry
|
---|
| 129 | ; 366.012 NCPDP PROCESSOR CONTACT MEANS Subfile
|
---|
| 130 | ; 366.022 PHARMACY BENEFITS MANAGER (PBM) CONTACT MEANS Subfile
|
---|
| 131 | ; 366.032 PLAN CONTACT MEANS Subfile
|
---|
| 132 | ; 366.0312 PLAN RX CONTACT MEANS Subfile
|
---|
| 133 | ;
|
---|
| 134 | D DELETE2^IBCNRFM1(FILENO,IEN,FIELDNO,CMIEN)
|
---|
| 135 | Q
|
---|
| 136 | ;
|
---|
| 137 | FILE ; File data
|
---|
| 138 | ; 365.12 PAYER File
|
---|
| 139 | ; 366.01 NCPDP PROCESSOR File
|
---|
| 140 | ; 366.02 PHARMACY BENEFITS MANAGER (PBM) File
|
---|
| 141 | ; 366.03 PLAN File
|
---|
| 142 | ;
|
---|
| 143 | ; Add?
|
---|
| 144 | I IEN=-1 D ADD
|
---|
| 145 | ;
|
---|
| 146 | ; Update
|
---|
| 147 | D FILE1^IBCNRFM1(FILENO,IEN,.DATA)
|
---|
| 148 | Q
|
---|
| 149 | ;
|
---|
| 150 | FILEAP ; File APPLICATION Subfile data
|
---|
| 151 | ; 365.121 PAYER APPLICATION Subfile
|
---|
| 152 | ; 366.013 NCPDP PROCESSOR APPLICATION Subfile
|
---|
| 153 | ; 366.023 PHARMACY BENEFITS MANAGER (PBM) APPLICATION Subfile
|
---|
| 154 | ; 366.033 PLAN APPLICATION Subfile
|
---|
| 155 | ;
|
---|
| 156 | ; Add?
|
---|
| 157 | I APIEN=-1 D ADDAP
|
---|
| 158 | ;
|
---|
| 159 | ; Update
|
---|
| 160 | D FILE2^IBCNRFM1(FILENO,IEN,FIELDNO,APIEN,.DATAAP)
|
---|
| 161 | Q
|
---|
| 162 | ;
|
---|
| 163 | FILEBPS ; File data
|
---|
| 164 | ; 90002312.92 BPS NCPDP FORMATS File
|
---|
| 165 | ;
|
---|
| 166 | N FILENO1
|
---|
| 167 | S FILENO1=9002313.92
|
---|
| 168 | ;
|
---|
| 169 | ; Update Billing Payer Sheet Entry?
|
---|
| 170 | S BPSIEN=DATA(10.07) I BPSIEN'="@" D
|
---|
| 171 | . D FILE1^IBCNRFM1(FILENO1,BPSIEN,.DATABPS)
|
---|
| 172 | ;
|
---|
| 173 | ; Update Rebill Payer Sheet Entry?
|
---|
| 174 | S BPSIEN=DATA(10.09) I BPSIEN'="@" D
|
---|
| 175 | . D FILE1^IBCNRFM1(FILENO1,BPSIEN,.DATABPS)
|
---|
| 176 | ;
|
---|
| 177 | ; Update Reversal Payer Sheet Entry?
|
---|
| 178 | S BPSIEN=DATA(10.08) I BPSIEN'="@" D
|
---|
| 179 | . ;
|
---|
| 180 | . ; 1.03 = Maximum RX's Per Claim
|
---|
| 181 | . S DATABPS(1.03)=1
|
---|
| 182 | . ;
|
---|
| 183 | . ; 1.07 = Is A Reversal Format
|
---|
| 184 | . S DATABPS(1.07)=1
|
---|
| 185 | . ;
|
---|
| 186 | . D FILE1^IBCNRFM1(FILENO1,BPSIEN,.DATABPS)
|
---|
| 187 | Q
|
---|
| 188 | ;
|
---|
| 189 | FILECM ; File CONTACT MEANS Subfile data
|
---|
| 190 | ; 366.012 NCPDP PROCESSOR CONTACT MEANS Subfile
|
---|
| 191 | ; 366.022 PHARMACY BENEFITS MANAGER (PBM) CONTACT MEANS Subfile
|
---|
| 192 | ; 366.032 PLAN CONTACT MEANS Subfile
|
---|
| 193 | ; 366.0312 PLAN RX CONTACT MEANS Subfile
|
---|
| 194 | ;
|
---|
| 195 | ; Add?
|
---|
| 196 | I CMIEN=-1 D ADDCM
|
---|
| 197 | ;
|
---|
| 198 | ; Update
|
---|
| 199 | D FILE2^IBCNRFM1(FILENO,IEN,FIELDNO,CMIEN,.DATACM)
|
---|
| 200 | Q
|
---|
| 201 | ;
|
---|
| 202 | MFE ; Process MFE Segment
|
---|
| 203 | D ^IBCNRMFE
|
---|
| 204 | Q
|
---|
| 205 | ;
|
---|
| 206 | ZP0 ; Process ZP0 Segment
|
---|
| 207 | D ^IBCNRZP0
|
---|
| 208 | Q
|
---|
| 209 | ;
|
---|
| 210 | ZCM ; Process ZCM Segment
|
---|
| 211 | D ^IBCNRZCM
|
---|
| 212 | Q
|
---|
| 213 | ;
|
---|
| 214 | ZPB ; Process ZPB Segment
|
---|
| 215 | D ^IBCNRZPB
|
---|
| 216 | Q
|
---|
| 217 | ;
|
---|
| 218 | ZPL ; Process ZPL Segment
|
---|
| 219 | D ^IBCNRZPL
|
---|
| 220 | Q
|
---|
| 221 | ;
|
---|
| 222 | ZPT ; Process ZPT Segment
|
---|
| 223 | D ^IBCNRZPT
|
---|
| 224 | Q
|
---|
| 225 | ;
|
---|
| 226 | ZRX ; Process ZRX Segment
|
---|
| 227 | D ^IBCNRZRX
|
---|
| 228 | Q
|
---|