source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCNBLE1.m@ 1259

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

initial load of WorldVistAEHR

File size: 5.5 KB
Line 
1IBCNBLE1 ;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 ;
8BLD ; 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")
80BLDX ;
81 Q
82 ;
83SYMTXT(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)))
92SYMX ;
93 Q
94 ;
95ECERR ; 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
142ECERRX ;
143 Q
144 ;
145SIDERR(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)
160SIDX Q ERR
161 ;
Note: See TracBrowser for help on using the repository browser.