| [613] | 1 | IBCNBLE1 ;DAOU/ESG - Ins Buffer, Expand Entry, con't ;25-JUN-2002
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**184,271**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ; Can't be called from the top
|
|---|
| 6 | Q
|
|---|
| 7 | ;
|
|---|
| 8 | BLD ; Continuation of Expand Entry list build procedure
|
|---|
| 9 | ; --- Called by IBCNBLE
|
|---|
| 10 | ;
|
|---|
| 11 | NEW ERR,MSG,IBL,IBY,IBLINE,IBER,IBLN,EDITED,ORIGSYME,ORIGSYMI,EEUPDATE
|
|---|
| 12 | NEW ORIGSYMS
|
|---|
| 13 | ;
|
|---|
| 14 | ; save the external and internal IIV status values
|
|---|
| 15 | S ORIGSYMS=$$SYMBOL^IBCNBLL(IBBUFDA)
|
|---|
| 16 | S ORIGSYME=$$GET1^DIQ(355.33,IBBUFDA,.12,"E")
|
|---|
| 17 | S ORIGSYMI=$P(IB0,U,12)
|
|---|
| 18 | ;
|
|---|
| 19 | ; Determine if Expand Entry is allowed to update the IIV Status
|
|---|
| 20 | S EEUPDATE=1 ; default Expand Entry update flag to true
|
|---|
| 21 | I ORIGSYMI,'$P($G(^IBE(365.15,ORIGSYMI,0)),U,3) S EEUPDATE=0
|
|---|
| 22 | ;
|
|---|
| 23 | ; Do not update the IIV status if manually verified
|
|---|
| 24 | I ORIGSYMS="*" S EEUPDATE=0
|
|---|
| 25 | ;
|
|---|
| 26 | ; If the current IIV Status allows updates by Expand Entry, then
|
|---|
| 27 | ; invoke the function that trys to find a valid payer
|
|---|
| 28 | I EEUPDATE D
|
|---|
| 29 | . S ERR=$$INSERROR^IBCNEUT3("B",IBBUFDA,1,.MSG)
|
|---|
| 30 | . ; If no errors, then remove the IIV Status
|
|---|
| 31 | . I 'ERR S ERR=$$SIDERR(IBBUFDA,$P(ERR,U,2))
|
|---|
| 32 | . I 'ERR D CLEAR^IBCNEUT4(IBBUFDA,.EDITED)
|
|---|
| 33 | . ; If errors found, then update with the new IIV Status
|
|---|
| 34 | . I ERR D BUFF^IBCNEUT2(IBBUFDA,$P(ERR,U,1)) S EDITED=1
|
|---|
| 35 | . ; refresh the IB0 variable for the possible symbol change
|
|---|
| 36 | . S $P(IB0,U,12)=$P($G(^IBA(355.33,IBBUFDA,0)),U,12)
|
|---|
| 37 | . Q
|
|---|
| 38 | ;
|
|---|
| 39 | ; Possibly display information if the OVERRIDE FRESHNESS FLAG is on
|
|---|
| 40 | I $P(IB0,U,13) D
|
|---|
| 41 | . S IBL="User Requested Inquiry?: ",IBY="YES"
|
|---|
| 42 | . S IBLINE=$$SETL^IBCNBLE("",IBY,IBL,18,3)
|
|---|
| 43 | . D SET^IBCNBLE(IBLINE) S IBLINE=""
|
|---|
| 44 | . Q
|
|---|
| 45 | ;
|
|---|
| 46 | ; Display the Current Status line
|
|---|
| 47 | S IBL="Current IIV Status: "
|
|---|
| 48 | S IBY=$$GET1^DIQ(355.33,IBBUFDA,.12,"E")
|
|---|
| 49 | I IBY="",$$SYMBOL^IBCNBLL(IBBUFDA)'="*" S IBY="No problems identified, Awaiting electronic processing"
|
|---|
| 50 | I $$SYMBOL^IBCNBLL(IBBUFDA)="*" S IBY="Manually verified, No IIV activity at this time"
|
|---|
| 51 | S IBLINE=$$SETL^IBCNBLE("",IBY,IBL,18,80)
|
|---|
| 52 | D SET^IBCNBLE(IBLINE) S IBLINE=""
|
|---|
| 53 | ;
|
|---|
| 54 | ; Display any text returned by the payer function
|
|---|
| 55 | F IBER=1:1:$G(MSG) D SET^IBCNBLE(" ") F IBLN=1:1:$P($G(MSG(IBER)),U,2) D SET^IBCNBLE(" "_$G(MSG(IBER,IBLN)))
|
|---|
| 56 | ;
|
|---|
| 57 | ; Display the current IIV Status generic description
|
|---|
| 58 | D SYMTXT($P(IB0,U,12),1)
|
|---|
| 59 | D SYMTXT($P(IB0,U,12),2)
|
|---|
| 60 | ;
|
|---|
| 61 | ; If the IIV Status ien changed from what it once was, then display the
|
|---|
| 62 | ; Prior Status line
|
|---|
| 63 | I ORIGSYMI'=$P(IB0,U,12) D
|
|---|
| 64 | . I $P(IB0,U,12) D SET^IBCNBLE(" ")
|
|---|
| 65 | . S IBL="Prior Status: "
|
|---|
| 66 | . S IBY=ORIGSYME
|
|---|
| 67 | . I IBY="",ORIGSYMS'="*" S IBY="No problems identified, Awaiting electronic processing"
|
|---|
| 68 | . I ORIGSYMS="*" S IBY="Manually verified, No IIV activity at this time"
|
|---|
| 69 | . S IBLINE=$$SETL^IBCNBLE("",IBY,IBL,18,80)
|
|---|
| 70 | . D SET^IBCNBLE(IBLINE) S IBLINE=""
|
|---|
| 71 | . D SYMTXT(ORIGSYMI,1)
|
|---|
| 72 | . Q
|
|---|
| 73 | ;
|
|---|
| 74 | ; Display any existing EC errors
|
|---|
| 75 | D ECERR
|
|---|
| 76 | ;D SET^IBCNBLE(" ")
|
|---|
| 77 | ;
|
|---|
| 78 | ; If the IIV Status was modified then refresh the visual display
|
|---|
| 79 | I $G(EDITED) D UPDLN^IBCNBLL(IBBUFDA,"EDITED")
|
|---|
| 80 | BLDX ;
|
|---|
| 81 | Q
|
|---|
| 82 | ;
|
|---|
| 83 | SYMTXT(IEN,TYPE) ; Display the text from the IIV symbol file for this entry
|
|---|
| 84 | ; TYPE=1 - Display Description from IIV Status Table file
|
|---|
| 85 | ; TYPE=2 - Display Corrective Action from IIV Status Table file
|
|---|
| 86 | NEW IBJ
|
|---|
| 87 | I '$G(IEN) G SYMX
|
|---|
| 88 | I '$P($G(^IBE(365.15,IEN,TYPE,0)),U,4) G SYMX
|
|---|
| 89 | D SET^IBCNBLE(" ")
|
|---|
| 90 | S IBJ=0
|
|---|
| 91 | F S IBJ=$O(^IBE(365.15,IEN,TYPE,IBJ)) Q:'IBJ D SET^IBCNBLE(" "_$G(^IBE(365.15,IEN,TYPE,IBJ,0)))
|
|---|
| 92 | SYMX ;
|
|---|
| 93 | Q
|
|---|
| 94 | ;
|
|---|
| 95 | ECERR ; Display the Eligibility Communicator Error data from the
|
|---|
| 96 | ; response file if it exists
|
|---|
| 97 | ;
|
|---|
| 98 | NEW RESP,RESPDATA,ERRTXT,IBY,IBLINE,ERRDATA,FUTDT,TQIEN,IBERR,IBCT
|
|---|
| 99 | S RESP=$O(^IBCN(365,"AF",IBBUFDA,""),-1)
|
|---|
| 100 | I 'RESP G ECERRX
|
|---|
| 101 | S RESPDATA=$G(^IBCN(365,RESP,1))
|
|---|
| 102 | S ERRTXT=$P($G(^IBCN(365,RESP,4)),U,1)
|
|---|
| 103 | S TQIEN=+$P($G(^IBCN(365,RESP,0)),U,5) ; Trans Queue file ien
|
|---|
| 104 | S FUTDT=$P($G(^IBCN(365.1,TQIEN,0)),U,9) ; Future date to transmit
|
|---|
| 105 | I '$P(RESPDATA,U,14),'$P(RESPDATA,U,15),ERRTXT="",'FUTDT G ECERRX
|
|---|
| 106 | ;
|
|---|
| 107 | ; At this point, we know there's something to get displayed
|
|---|
| 108 | ;
|
|---|
| 109 | ; Display section header
|
|---|
| 110 | D SET^IBCNBLE(" ")
|
|---|
| 111 | S IBY=$J("",19)_"Eligibility Communicator Error Information"
|
|---|
| 112 | D SET^IBCNBLE(IBY,"B") S IBLINE=""
|
|---|
| 113 | ;
|
|---|
| 114 | ; Display Error Condition data - field# 1.14
|
|---|
| 115 | I $P(RESPDATA,U,14) D
|
|---|
| 116 | . S ERRDATA=$G(^IBE(365.017,$P(RESPDATA,U,14),0))
|
|---|
| 117 | . K IBERR
|
|---|
| 118 | . S IBERR(1)=$P(ERRDATA,U,2)_" (Error Condition '"_$P(ERRDATA,U,1)_"')"
|
|---|
| 119 | . D TXT^IBCNEUT7("IBERR")
|
|---|
| 120 | . F IBCT=1:1:$O(IBERR(""),-1) D SET^IBCNBLE(IBERR(IBCT))
|
|---|
| 121 | . Q
|
|---|
| 122 | ;
|
|---|
| 123 | ; Display Error Action data - field# 1.15
|
|---|
| 124 | I $P(RESPDATA,U,15) D
|
|---|
| 125 | . S ERRDATA=$G(^IBE(365.018,$P(RESPDATA,U,15),0))
|
|---|
| 126 | . K IBERR
|
|---|
| 127 | . S IBERR(1)=$P(ERRDATA,U,2)_" (Error Action '"_$P(ERRDATA,U,1)_"')"
|
|---|
| 128 | . D TXT^IBCNEUT7("IBERR")
|
|---|
| 129 | . F IBCT=1:1:$O(IBERR(""),-1) D SET^IBCNBLE(IBERR(IBCT))
|
|---|
| 130 | . Q
|
|---|
| 131 | ;
|
|---|
| 132 | ; Display Error Text data - field# 4.01
|
|---|
| 133 | I ERRTXT'="" D SET^IBCNBLE(ERRTXT)
|
|---|
| 134 | ;
|
|---|
| 135 | ; Display Date of Future Transmission - field# .09 in file 365.1
|
|---|
| 136 | I FUTDT D
|
|---|
| 137 | . S FUTDT=$$FMTE^XLFDT(FUTDT,"5Z")
|
|---|
| 138 | . D SET^IBCNBLE(" ")
|
|---|
| 139 | . S IBLINE=" Date of Future Transmission: "_FUTDT
|
|---|
| 140 | . D SET^IBCNBLE(IBLINE) S IBLINE=""
|
|---|
| 141 | . Q
|
|---|
| 142 | ECERRX ;
|
|---|
| 143 | Q
|
|---|
| 144 | ;
|
|---|
| 145 | SIDERR(BUF,PIEN) ;
|
|---|
| 146 | ; If Subscriber ID is required and SSN cannot be substituted
|
|---|
| 147 | ; and buffer does not have a sub id -> return error
|
|---|
| 148 | ; BUF = buffer IEN
|
|---|
| 149 | ; PIEN = payer IEN
|
|---|
| 150 | ;
|
|---|
| 151 | N ERR,SID,APPIEN,SIDSTR,SIDREQ,SIDSSN
|
|---|
| 152 | S ERR=""
|
|---|
| 153 | S SID=$P($G(^IBA(355.33,BUF,60)),U,4)
|
|---|
| 154 | I SID]"" G SIDX ; Subscriber id is populated, further checking is moot
|
|---|
| 155 | S APPIEN=$$PYRAPP^IBCNEUT5("IIV",PIEN)
|
|---|
| 156 | S SIDSTR=$G(^IBE(365.12,PIEN,1,APPIEN,0))
|
|---|
| 157 | S SIDREQ=$P(SIDSTR,U,8) I 'SIDREQ G SIDX ; if sub id is not req'd - ok
|
|---|
| 158 | S SIDSSN=$P(SIDSTR,U,9)
|
|---|
| 159 | I 'SIDSSN S ERR=18 ; if ssn cannot be used -> B15 status (IEN = 18)
|
|---|
| 160 | SIDX Q ERR
|
|---|
| 161 | ;
|
|---|
