| 1 | IBCNEHL3 ;DAOU/ALA - HL7 Process Incoming RPI Continued ;03-JUL-2002 ; Compiled June 2, 2005 14:20:19
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**300**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ;**Program Description**
|
|---|
| 6 | ; This is a continuation of IBCNEHL1 which processes an incoming
|
|---|
| 7 | ; RPI IIV message.
|
|---|
| 8 | ;
|
|---|
| 9 | ; This routine is based on IBCNEHLS which was introduced with patch 184, and subsequently
|
|---|
| 10 | ; patched with patch 271. IBCNEHLS is obsolete and deleted with patch 300.
|
|---|
| 11 | ;
|
|---|
| 12 | Q ; no direct calls allow
|
|---|
| 13 | ;
|
|---|
| 14 | ERROR(TQN,ERACT,ERCON,TRCN) ; Entry point
|
|---|
| 15 | ; Input: TQN - IEN for IIV Transmission Queue (#365.1), required
|
|---|
| 16 | ; ERACT - Error Action Code (#365.14), required
|
|---|
| 17 | ; ERCON - Error Condition Code (#365.17), required
|
|---|
| 18 | ; TRCN - Trace # from IIV Response (#365)
|
|---|
| 19 | ;
|
|---|
| 20 | ; IIVSTAT - IIV status transmitted by EC
|
|---|
| 21 | ; Note: MAP(IIVSTAT) = IIV STATUS IEN
|
|---|
| 22 | N MSG,ERDESC,ERIEN,XMY,DA,DIE,DR
|
|---|
| 23 | ;
|
|---|
| 24 | I $G(TQN)="" G ERRORX
|
|---|
| 25 | ;
|
|---|
| 26 | ; Scenarios:
|
|---|
| 27 | ; #1 - If error message = "Resubmission Allowed" OR "Please Resubmit
|
|---|
| 28 | ; Original Transaction" - set TQ
|
|---|
| 29 | ; Fut Trans Dt to T + Comm Failure Days and Status to "Hold"
|
|---|
| 30 | I ERACT="R"!(ERACT="P") D G ERRORX
|
|---|
| 31 | . I $P($G(^IBCN(365.1,TQN,0)),U,9)="" D Q ; first time payer asked us to resubmit
|
|---|
| 32 | . . ; Update IIV TQ fields: "Hold" (4), IIV Site Param Comm Failure Days
|
|---|
| 33 | . . D UPDATE(TQN,4,+$P($G(^IBE(350.9,1,51)),U,5),ERACT)
|
|---|
| 34 | . . ;
|
|---|
| 35 | . ; payer asked us to resubmit for the 2nd time for this inquiry
|
|---|
| 36 | . ; Update IIV TQ fields: "Response Received" (3), n/a ("")
|
|---|
| 37 | . D UPDATE(TQN,3,"",ERACT,ERCON)
|
|---|
| 38 | . ; clear future transmission date so it won't display in the buffer
|
|---|
| 39 | . S DA=TQN,DIE="^IBCN(365.1,",DR=".09///@" D ^DIE
|
|---|
| 40 | ;
|
|---|
| 41 | ; #2 - If error message = "Please Wait 30 Days and Resubmit" - set TQ
|
|---|
| 42 | ; Fut Trans Dt to T + 30 and Status to "Hold"
|
|---|
| 43 | I ERACT="W" D G ERRORX
|
|---|
| 44 | . ; Update IIV TQ fields: "Hold" (4), 30
|
|---|
| 45 | . D UPDATE(TQN,4,30,ERACT)
|
|---|
| 46 | ;
|
|---|
| 47 | ; #3 - If error message = "Please Wait 10 Days and Resubmit" - set TQ
|
|---|
| 48 | ; Fut Trans Dt to T + 10 and Status to "Hold"
|
|---|
| 49 | I ERACT="X" D G ERRORX
|
|---|
| 50 | . ; Update IIV TQ fields: "Hold" (4), 10
|
|---|
| 51 | . D UPDATE(TQN,4,10,ERACT)
|
|---|
| 52 | ;
|
|---|
| 53 | ; #4 - If error message = "Resubmission Not Allowed" or
|
|---|
| 54 | ; "Do not resubmit ...." OR "Please correct and resubmit"
|
|---|
| 55 | ; - set TQ Status to "Response Received"
|
|---|
| 56 | ; If we receive error txt, treat as an "N"
|
|---|
| 57 | I ERACT="" S ERACT="N"
|
|---|
| 58 | I ERACT="N"!(ERACT="Y")!(ERACT="S")!(ERACT="C") D G ERRORX
|
|---|
| 59 | . ; Update IIV TQ fields: "Response Received" (3), n/a ("")
|
|---|
| 60 | . D UPDATE(TQN,3,"",ERACT,ERCON)
|
|---|
| 61 | ;
|
|---|
| 62 | ; #5 - Error message is unfamiliar - new Error Action Code
|
|---|
| 63 | ; *** Currently processed in IBCNEHL1 ***
|
|---|
| 64 | ;
|
|---|
| 65 | ERRORX ; ERROR exit pt
|
|---|
| 66 | Q
|
|---|
| 67 | ;
|
|---|
| 68 | UPDATE(TQN,TSTS,TDAYS,ERACT,ERCON) ; Update Transmission Queue (#365.1)
|
|---|
| 69 | ; Update/Create Buffer information as necessary
|
|---|
| 70 | ; * If unsolicited error or negative Verification response do not
|
|---|
| 71 | ; update TQ entry. However, create a new Buffer entry.
|
|---|
| 72 | ; Input Variables
|
|---|
| 73 | ; ERACT,ERCON,IIVSTAT,TDAYS,TQN,TSTS
|
|---|
| 74 | ;
|
|---|
| 75 | ; Output Variables
|
|---|
| 76 | ; IIVSTAT (updated)
|
|---|
| 77 | ;
|
|---|
| 78 | ; Init optional param
|
|---|
| 79 | S ERCON=$G(ERCON)
|
|---|
| 80 | ;
|
|---|
| 81 | ; Init vars
|
|---|
| 82 | N D,D0,DA,DFN,DI,DIC,DIE,DQ,DR,FTDT,IBDATA,IBIEN,IBQFL,IBSTS,IBSYM
|
|---|
| 83 | N INSIEN,RSTYPE,SYMBOL,TQDATA,X
|
|---|
| 84 | ;
|
|---|
| 85 | ; If no ZEB segment received, set IIVSTAT to "V"
|
|---|
| 86 | I $TR(IIVSTAT," ")="" S IIVSTAT="V"
|
|---|
| 87 | ;
|
|---|
| 88 | S TQDATA=$G(^IBCN(365.1,TQN,0))
|
|---|
| 89 | I TQDATA="" G UPDATX
|
|---|
| 90 | ;
|
|---|
| 91 | ; Ins Buffer IEN
|
|---|
| 92 | S IBIEN=$P(TQDATA,U,5)
|
|---|
| 93 | S IBQFL=$P(TQDATA,U,11)
|
|---|
| 94 | S RSTYPE=$P($G(^IBCN(365,RIEN,0)),U,10)
|
|---|
| 95 | ;
|
|---|
| 96 | ; If unsolicited error or negative Identification response DON'T
|
|---|
| 97 | ; update TQ entry or Buffer (includes not creating a new buffer)
|
|---|
| 98 | I RSTYPE="U",(IBQFL="I") G UPDATX
|
|---|
| 99 | ;
|
|---|
| 100 | I RSTYPE="U" S IBIEN="" ; makes sure a new buffer is created
|
|---|
| 101 | ;
|
|---|
| 102 | ; Ins Buffer processing
|
|---|
| 103 | I IBIEN'="" D
|
|---|
| 104 | . ; Ins Buf data
|
|---|
| 105 | . S IBDATA=$G(^IBA(355.33,+IBIEN,0))
|
|---|
| 106 | . S IBSTS=$P(IBDATA,U,4) ; Status
|
|---|
| 107 | . S IBSYM=$P(IBDATA,U,12) ; Symbol
|
|---|
| 108 | . ; If IB status is (A)ccepted or (R)ejected or IB symbol is "*"
|
|---|
| 109 | . ; (verified) or IB symbol is "-" (denied), update TQ status to
|
|---|
| 110 | . ; Resp Rec'd (3) and DON'T update the Ins Buffer symbol
|
|---|
| 111 | . I IBSTS="A"!(IBSTS="R")!(IBSYM=8)!(IBSYM=9) S TSTS=3 Q
|
|---|
| 112 | . ; If TQ status is "Hold", update buffer symbol to "?" (10)
|
|---|
| 113 | . I TSTS=4 D BUFF^IBCNEUT2(IBIEN,10) Q ; Set buffer symbol to "?"
|
|---|
| 114 | . ; If TQ status is "Response Received", update buffer symbol to "-" (9) for Error
|
|---|
| 115 | . ; Action Codes ('N','Y','S') & Action Codes ('P','R', if 2nd time payer sent that code)
|
|---|
| 116 | . I TSTS=3,(ERACT="N"!(ERACT="Y")!(ERACT="S")!(ERACT="C")!(ERACT="P")!(ERACT="R")) D Q
|
|---|
| 117 | .. S SYMBOL=MAP(IIVSTAT)
|
|---|
| 118 | .. D BUFF^IBCNEUT2(IBIEN,SYMBOL) ; Set buffer symbol to EC value
|
|---|
| 119 | .. D IIVPROC(IBIEN) ; Set IIV process date & IIV status
|
|---|
| 120 | . ; If TQ status is "Response Received", update buffer symbol to "!" (12 = B9) for new Error Action Code
|
|---|
| 121 | . I TSTS=3,",W,X,R,P,C,N,Y,S,"'[(","_ERACT_",") D BUFF^IBCNEUT2(IBIEN,22) Q
|
|---|
| 122 | ;
|
|---|
| 123 | ; Non-Ins Buffer processing, create entry only for Verification queries
|
|---|
| 124 | I IBIEN="",IBQFL="V" D
|
|---|
| 125 | . ; Determine Patient DFN
|
|---|
| 126 | . S DFN=$P(TQDATA,U,2)
|
|---|
| 127 | . ; Determine Patient Ins record IEN
|
|---|
| 128 | . S INSIEN=$P(TQDATA,U,13) ; If INSIEN="" avoids TQ update
|
|---|
| 129 | . ; If ERACT="C" symbol is passed by EC
|
|---|
| 130 | . I ERACT="C" S SYMBOL=MAP(IIVSTAT) D BUF Q
|
|---|
| 131 | . ; Resubmission Not Allowed or Do Not Resubmit ...
|
|---|
| 132 | . I ERACT="N"!(ERACT="Y")!(ERACT="S") S SYMBOL=MAP(IIVSTAT) D BUF Q
|
|---|
| 133 | . ; An unknown error action - generate a '#'
|
|---|
| 134 | . I ",W,X,R,P,C,N,Y,S,"'[(","_ERACT_",") S SYMBOL=22 D BUF Q
|
|---|
| 135 | ;
|
|---|
| 136 | I RSTYPE="U" G UPDATX ; finished creating new buffer
|
|---|
| 137 | ;
|
|---|
| 138 | ; Update TQ record - Status
|
|---|
| 139 | D SST^IBCNEUT2(TQN,TSTS)
|
|---|
| 140 | ;
|
|---|
| 141 | ; If TQ Status = "Hold", update TQ record - Future Transmission Date
|
|---|
| 142 | I TSTS=4,+$G(TDAYS) D
|
|---|
| 143 | . S FTDT=$$FMADD^XLFDT($$DT^XLFDT,TDAYS)
|
|---|
| 144 | . S DIE="^IBCN(365.1,",DA=TQN,DR=".09///^S X=FTDT"
|
|---|
| 145 | . D ^DIE
|
|---|
| 146 | I TSTS=4,$P(TQDATA,U,8) D
|
|---|
| 147 | . S DIE="^IBCN(365.1,",DA=TQN,DR=".08///0"
|
|---|
| 148 | . D ^DIE
|
|---|
| 149 | ;
|
|---|
| 150 | UPDATX ; UPDATE exit point
|
|---|
| 151 | Q
|
|---|
| 152 | ;
|
|---|
| 153 | PCK ; Payer Check
|
|---|
| 154 | ; Find the associated Response IEN
|
|---|
| 155 | ;
|
|---|
| 156 | ; Input Variables
|
|---|
| 157 | ; MSGID
|
|---|
| 158 | ;
|
|---|
| 159 | ; Output Variables
|
|---|
| 160 | ; RIEN,ERFLG
|
|---|
| 161 | ;
|
|---|
| 162 | N BUFF,DA,DFN,DIE,DR,IEN,IERN,IN1DATA,MDTM,QFL,PAYR,PIEN,PP
|
|---|
| 163 | N PRDATA,PRIEN,RSIEN,X
|
|---|
| 164 | N NOPAYER,TQIEN
|
|---|
| 165 | ;
|
|---|
| 166 | K ^TMP("IBCNEMID",$J)
|
|---|
| 167 | D FIND^DIC(365,"","","P",MSGID,"","B","","","^TMP(""IBCNEMID"",$J)")
|
|---|
| 168 | ;
|
|---|
| 169 | S PP=0,QFL=0,(RIEN,PIEN)=""
|
|---|
| 170 | S NOPAYER=$$FIND1^DIC(365.12,,"X","~NO PAYER"),TQIEN=$O(^IBCN(365.1,"C",MSGID,""))
|
|---|
| 171 | F S PP=$O(^TMP("IBCNEMID",$J,"DILIST",PP)) Q:'PP D Q:QFL
|
|---|
| 172 | . S PRIEN=$P(^TMP("IBCNEMID",$J,"DILIST",PP,0),U,1)
|
|---|
| 173 | . ;
|
|---|
| 174 | . ; If this is a response w/o an IN1 segment
|
|---|
| 175 | . ; Get payer IEN from TQ as original response shell will change for
|
|---|
| 176 | . ; ~NO PAYER if a payer response is received
|
|---|
| 177 | . S IN1DATA=$$GIN1()
|
|---|
| 178 | . I IN1DATA="",PRIEN'="",TQIEN'="" D
|
|---|
| 179 | .. S QFL=1,PIEN=$P(^IBCN(365.1,TQIEN,0),U,3)
|
|---|
| 180 | . ;
|
|---|
| 181 | . I 'PIEN D PFN(IN1DATA) I 'PIEN S QFL=1 Q
|
|---|
| 182 | . ;
|
|---|
| 183 | . ; If message id/payer found & Response (#365) status is NOT
|
|---|
| 184 | . ; 'Response Received' update the existing response entry (set RIEN)
|
|---|
| 185 | . I $P(^IBCN(365,PRIEN,0),U,3)=PIEN,($P(^IBCN(365,PRIEN,0),U,6)'=3) D Q
|
|---|
| 186 | .. S RIEN=PRIEN,QFL=1
|
|---|
| 187 | ..;
|
|---|
| 188 | ..; If message id/payer found & Response (#365) status equals
|
|---|
| 189 | . ; 'Response Received', RIEN is still null so that this tag knows
|
|---|
| 190 | . ; to create a new unsolicited response entry
|
|---|
| 191 | . ;
|
|---|
| 192 | . ; If payer response received to ~NO PAYER, update IIV Response file
|
|---|
| 193 | . ; w/ responding payer
|
|---|
| 194 | . I RIEN="" S PRDATA=$G(^IBCN(365,PRIEN,0)) I $P(PRDATA,U,3)=NOPAYER,$P(PRDATA,U,6)'=3,$P(PRDATA,U,10)="O" D Q
|
|---|
| 195 | .. S RIEN=PRIEN,QFL=1
|
|---|
| 196 | .. S DIE="^IBCN(365,",DA=RIEN,DR=".03///^S X=PIEN" D ^DIE
|
|---|
| 197 | ;
|
|---|
| 198 | ; If message id/payer not found or unsolicited response, create new response entry
|
|---|
| 199 | I RIEN="" D Q:ERFLG
|
|---|
| 200 | . I $G(PRIEN)'="" D
|
|---|
| 201 | .. S PRDATA=$G(^IBCN(365,PRIEN,0))
|
|---|
| 202 | .. S DFN=$P(PRDATA,U,2),IEN=$P(PRDATA,U,5),MDTM=$P(PRDATA,U,8)
|
|---|
| 203 | . ;
|
|---|
| 204 | . I PIEN="" D Q:ERFLG
|
|---|
| 205 | .. S IN1DATA=$$GIN1()
|
|---|
| 206 | .. I IN1DATA]"" D PFN(IN1DATA) I 'PIEN S PIEN="",QFL=1
|
|---|
| 207 | . S PAYR=PIEN,(RSTYPE,BUFF)=""
|
|---|
| 208 | . D RESP^IBCNEDEQ
|
|---|
| 209 | . S RIEN=RSIEN
|
|---|
| 210 | ;
|
|---|
| 211 | ; If no payer in response file, set it
|
|---|
| 212 | I $G(PIEN)'="",$G(RIEN)'="",$P($G(^IBCN(365,PIEN,0)),U,3)="" D
|
|---|
| 213 | . S DIE="^IBCN(365,",DA=RIEN,DR=".03///^S X=PIEN" D ^DIE
|
|---|
| 214 | Q
|
|---|
| 215 | ;
|
|---|
| 216 | BUF ; Create Buffer Record if Doesn't Exist
|
|---|
| 217 | ;
|
|---|
| 218 | ; Input Variables
|
|---|
| 219 | ; RIEN,RSTYPE,TQN
|
|---|
| 220 | ;
|
|---|
| 221 | ; Output Variables
|
|---|
| 222 | ; ERROR,SYMBOL is killed,TQIEN and IRIEN may be reset
|
|---|
| 223 | ;
|
|---|
| 224 | N BUFF,IBFDA,UP
|
|---|
| 225 | I $G(RSTYPE)="U" S (TQIEN,IRIEN)=""
|
|---|
| 226 | D RP^IBCNEBF(RIEN,1)
|
|---|
| 227 | S BUFF=+IBFDA
|
|---|
| 228 | S UP(365,RIEN_",",.04)=+IBFDA
|
|---|
| 229 | I RSTYPE="O" S UP(365.1,TQN_",",.05)=+IBFDA
|
|---|
| 230 | D FILE^DIE("I","UP","ERROR")
|
|---|
| 231 | K SYMBOL
|
|---|
| 232 | Q
|
|---|
| 233 | ;
|
|---|
| 234 | IIVPROC(BUFF) ; Set IIV Processed Date to current dt/tm & IIV stat (aka SYMBOL)
|
|---|
| 235 | ; Input Variables
|
|---|
| 236 | ; BUFF
|
|---|
| 237 | ;
|
|---|
| 238 | ; Output Variables
|
|---|
| 239 | ; SYMBOL
|
|---|
| 240 | ;
|
|---|
| 241 | N IDUZ,UP
|
|---|
| 242 | S UP(355.33,BUFF_",",.15)=$$NOW^XLFDT()
|
|---|
| 243 | ; Set IDUZ to the specific, non-human user.
|
|---|
| 244 | S IDUZ=$$FIND1^DIC(200,"","X","INTERFACE,IB IIV")
|
|---|
| 245 | D FILE^DIE("I","UP","ERROR")
|
|---|
| 246 | ; set the symbol of the buffer entry
|
|---|
| 247 | D BUFF^IBCNEUT2(BUFF,SYMBOL) ; reset symbol to appropriate value
|
|---|
| 248 | Q
|
|---|
| 249 | ;
|
|---|
| 250 | PFN(IN1DATA) ; Find Payer from HL7 msg
|
|---|
| 251 | ;
|
|---|
| 252 | ; Input Variables
|
|---|
| 253 | ; IN1DATA, TRACE
|
|---|
| 254 | ;
|
|---|
| 255 | ; Output Variables
|
|---|
| 256 | ; ERFLG,ERROR,PIEN
|
|---|
| 257 | ;
|
|---|
| 258 | N IERN,PAYRID
|
|---|
| 259 | S PAYRID=$$CLNSTR^IBCNEHLU($P($P(IN1DATA,HLFS,4),$E(HL("ECH"))),HL("ECH"),$E(HL("ECH")))
|
|---|
| 260 | S PIEN=+$$FIND1^DIC(365.12,"","MX",PAYRID)
|
|---|
| 261 | I PIEN=0 D Q
|
|---|
| 262 | . S ERFLG=1,IERN=$$ERRN^IBCNEUT7("ERROR(""DIERR"")")
|
|---|
| 263 | . S ERROR("DIERR",IERN,"TEXT",1)="National Id: "_PAYRID_" not found in Payer Table"
|
|---|
| 264 | . S ERROR("DIERR",IERN,"TEXT",2)="for Trace Number: "_TRACE
|
|---|
| 265 | Q
|
|---|
| 266 | ;
|
|---|
| 267 | GIN1() ;Get IN1 segment
|
|---|
| 268 | ;
|
|---|
| 269 | ; Input Variables
|
|---|
| 270 | ; HCT
|
|---|
| 271 | ;
|
|---|
| 272 | ; Returns value of SEGMT
|
|---|
| 273 | ;
|
|---|
| 274 | N IPCT,SEGMT
|
|---|
| 275 | S IPCT=HCT,SEGMT=""
|
|---|
| 276 | F S IPCT=$O(^TMP($J,"IBCNEHLI",IPCT)) Q:IPCT="" D
|
|---|
| 277 | . I $E(^TMP($J,"IBCNEHLI",IPCT,0),1,3)="IN1" S SEGMT=^TMP($J,"IBCNEHLI",IPCT,0)
|
|---|
| 278 | Q SEGMT
|
|---|
