source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCNEUT4.m@ 940

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

initial load of FOIAVistA 6/30/08 version
File size: 8.2 KB
Line 
1IBCNEUT4 ;DAOU/ESG - eIV MISC. UTILITIES ;17-JUN-2002
2 ;;2.0;INTEGRATED BILLING;**184,271,345**;21-MAR-94;Build 28
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 ; Can't be called from the top
6 Q
7 ;
8 ;
9ACTIVE(INSDA) ; Is this insurance company currently active? 1:yes or 0:no
10 ; Insurance company name returned in the second piece.
11 ; Input: INSDA - insurance company ien
12 NEW ACTFLG,INSDATA
13 S ACTFLG=0 ; default inactive
14 I '$G(INSDA) G ACTIVEX ; bad data passed in
15 S INSDATA=$G(^DIC(36,INSDA,0)) ; zero node of File 36
16 I INSDATA="" G ACTIVEX ; bad record
17 I $P(INSDATA,U,5) G ACTIVEX ; INACTIVE flag is true
18 I $P($G(^DIC(36,INSDA,5)),U,1) G ACTIVEX ; SCHEDULED FOR DELETION flag is true
19 S ACTFLG=1 ; Otherwise, its active
20ACTIVEX ;
21 Q ACTFLG_U_$P($G(^DIC(36,+$G(INSDA),0)),U,1)
22 ;
23 ;
24EXCLUDE(NAME) ; This function determines if we should exclude the insurance
25 ; company based on the name.
26 ; This function returns 1 if we should exclude the insurance company.
27 ; This function returns 0 if we should not exclude it (i.e. include it)
28 ;
29 ; Initialize flag; default to not exclude it
30 NEW EXCL
31 S EXCL=0
32 ;
33 ; Screen out bad data
34 I $G(NAME)="" S EXCL=1 G EXCLUDX
35 ;
36 ; Screen out MEDICAID or MEDICARE ins co names
37 I NAME["MEDICAID"!(NAME["MEDICARE") S EXCL=1 G EXCLUDX
38EXCLUDX ;
39 Q EXCL
40 ;
41 ;
42CLEAR(DA,EDITED,FORCE) ; This procedure will clear the eIV status field from an
43 ; Insurance Buffer entry (pass in the internal entry number of the
44 ; buffer entry). If the FORCE variable is not passed then the eIV
45 ; status will only be cleared if the existing status is an error status
46 ;
47 ; Parameters
48 ; DA - required input parameter; buffer ien
49 ; EDITED - optional output parameter; this will tell you if the
50 ; buffer symbol was cleared
51 ; FORCE - optional input parameter; if this is set to 1 then the
52 ; eIV status field will be cleared regardless of the
53 ; current status
54 NEW DIE,DR,D,D0,DI,DIC,DISYS,DQ,X,%
55 I '$G(DA) G CLEARX
56 I '$D(FORCE) S FORCE=0
57 I 'FORCE,$$SYMBOL^IBCNBLL(DA)'="!" G CLEARX
58 S DIE=355.33,DR=".12///@"
59 D ^DIE
60 S EDITED=1
61CLEARX ;
62 Q
63 ;
64 ;
65INFO(IBBUFDA) ; Return original and current buffer data
66 ; This procedure will retrieve the following data from the buffer and
67 ; from the transmission queue file. The buffer holds the current data
68 ; and the TQ file holds the original buffer data.
69 ; Input
70 ; IBBUFDA - buffer internal entry number
71 ; Output
72 ; a pieced string as follows
73 ; [1] Has this buffer entry been transmitted? 1/0
74 ; [2] Current buffer source of information (external)
75 ; [3] Current buffer source of information (internal)
76 ; [4] Current buffer insurance company name
77 ; [5] Current buffer group number
78 ; [6] Current buffer group name
79 ; [7] Current buffer subscriber ID
80 ; [8] Original buffer insurance company name
81 ; [9] Original buffer group number
82 ; [10] Original buffer group name
83 ; [11] Original buffer subscriber ID
84 ;
85 NEW IB0,IB20,IB40,IB60,DATA,RESPIEN,FOUND,TQIEN,TQDATA,TQDATA1,DISYS
86 S DATA=""
87 I '$G(IBBUFDA) G INFOX
88 I '$D(^IBA(355.33,IBBUFDA)) G INFOX
89 S IB0=$G(^IBA(355.33,IBBUFDA,0))
90 S IB20=$G(^IBA(355.33,IBBUFDA,20))
91 S IB40=$G(^IBA(355.33,IBBUFDA,40))
92 S IB60=$G(^IBA(355.33,IBBUFDA,60))
93 S $P(DATA,U,1)=0 ; default to not been transmitted
94 S $P(DATA,U,2)=$$EXTERNAL^DILFD(355.33,.03,"",$P(IB0,U,3)) ; source
95 S $P(DATA,U,3)=$P(IB0,U,3) ; internal source
96 S $P(DATA,U,4)=$P(IB20,U,1) ; insurance company name
97 S $P(DATA,U,5)=$P(IB40,U,3) ; group number
98 S $P(DATA,U,6)=$P(IB40,U,2) ; group name
99 S $P(DATA,U,7)=$P(IB60,U,4) ; subscriber id
100 ;
101 ; Look at the response file and the transmission queue file. Since
102 ; we're trying to get the original data look at the oldest data first.
103 S RESPIEN=0,FOUND=0
104 F S RESPIEN=$O(^IBCN(365,"AF",IBBUFDA,RESPIEN)) Q:'RESPIEN D Q:FOUND
105 . S TQIEN=$P($G(^IBCN(365,RESPIEN,0)),U,5)
106 . I 'TQIEN Q
107 . S TQDATA=$G(^IBCN(365.1,TQIEN,0))
108 . S TQDATA1=$G(^IBCN(365.1,TQIEN,1))
109 . I TQDATA="" Q
110 . S $P(DATA,U,8)=$P(TQDATA1,U,2) ; insurance company name
111 . S $P(DATA,U,9)=$P(TQDATA1,U,3) ; group number
112 . S $P(DATA,U,10)=$P(TQDATA1,U,4) ; group name
113 . S $P(DATA,U,11)=$P(TQDATA1,U,5) ; subscriber id
114 . S FOUND=1 ; Stop once we have some data
115 . Q
116 ;
117 I FOUND S $P(DATA,U,1)=1
118INFOX ;
119 Q DATA
120 ;
121 ;
122VALID(INSIEN,PAYIEN,PAYID,SYMIEN) ; Validate an Ins Co IEN
123 ; Input parameter: INSIEN - Ins co IEN, passed by value
124 ; Output parameters: PAYIEN, PAYID, SYMIEN, passed by reference
125 N APPDATA,APPIEN,INSNAME
126 ; Retrieve the Ins Co name
127 S INSNAME=$P($G(^DIC(36,INSIEN,0)),U,1)
128 I INSNAME="" S SYMIEN=$$ERROR^IBCNEUT8("B9","Insurance company IEN "_INSIEN_" doesn't have a name on file.") G VALIDX
129 ; Screen out MEDICAID or MEDICARE ins co names
130 I $$EXCLUDE(INSNAME) S SYMIEN=$$ERROR^IBCNEUT8("B11","Insurance company "_INSNAME_" contains MEDICAID or MEDICARE in the name. Electronic inquiries cannot be made to this insurance company.") G VALIDX
131 ; Retrieve the Payer IEN associated with this ins co
132 S PAYIEN=$P($G(^DIC(36,INSIEN,3)),U,10)
133 I PAYIEN="" S SYMIEN=$$ERROR^IBCNEUT8("B4","Insurance company "_INSNAME_" is not linked to a Payer.") G VALIDX
134 D VALPYR(INSNAME) ; Payer val'n
135VALIDX ;
136 Q
137 ;
138PAYER(PAYIEN) ;
139 ; Entry pt for Most Pop Payer (called by POP^IBCNEDE4)
140 N SYMIEN,PAYID
141 N APPDATA,APPIEN ; Set within tag VALPYR these variables are never
142 ; killed. Using tag VALID's method of NEWing variables
143 ; first will allow them to be killed appropriately.
144 N ARRAY ; This is an array that is set by ERROR^IBCNEUT8 but never
145 ; killed. When there is a most popular payer that is not
146 ; eligible for inquiries, ARRAY would continue to grow.
147 S (SYMIEN,PAYID)=""
148 D VALPYR("")
149 Q SYMIEN_U_PAYID
150 ;
151VALPYR(INSNM) ;
152 ; Payer Val'n - note: PAYIEN (payer IEN) must be set
153 ; If INSNM="" val'n is for Most Pop Payer
154 N PAYNM
155 ;
156 S INSNM=$G(INSNM) ; Init variable if not passed
157 ; Retrieve the National ID(Payer ID) for this Payer IEN
158 S PAYID=$P($G(^IBE(365.12,PAYIEN,0)),U,2)
159 I PAYID="" S SYMIEN=$$ERROR^IBCNEUT8("B9","Payer IEN "_PAYIEN_" does not have a Payer.") Q
160 ; Retrieve payer name
161 S PAYNM=$P($G(^IBE(365.12,PAYIEN,0)),U,1)
162 ; Retrieve the IEN of the eIV Application
163 S APPIEN=$$PYRAPP^IBCNEUT5("IIV",PAYIEN)
164 I APPIEN="" S SYMIEN=$$ERROR^IBCNEUT8("B9","The eIV Payer Application has not been created for this site.") Q
165 ; Verify the existence of the application for this Payer
166 I '$D(^IBE(365.12,PAYIEN,1,APPIEN)) S SYMIEN=$$ERROR^IBCNEUT8("B7","Insurance company "_INSNM_" is linked to Payer "_PAYNM_" which is not set up to accept electronic insurance eligibility requests.") Q
167 ; Retrieve the eIV-specific application data for this Payer
168 S APPDATA=$G(^IBE(365.12,PAYIEN,1,APPIEN,0))
169 ; Check if the Payer doesn't have either an active national or an
170 ; active local connection and return one or, if applicable, BOTH errors
171 I '$P(APPDATA,U,3) S SYMIEN=$$ERROR^IBCNEUT8("B6","Insurance company "_INSNM_" is linked to Payer "_PAYNM_" which is not locally active for eIV.")
172 I '$P(APPDATA,U,2) S SYMIEN=$$ERROR^IBCNEUT8("B5","Insurance company "_INSNM_" is linked to Payer "_PAYNM_" which is not nationally active for eIV.")
173 ; Check if the Payer has been deactivated, if so report it
174 I $P(APPDATA,U,11) S SYMIEN=$$ERROR^IBCNEUT8("B14","Insurance company "_INSNM_" is linked to Payer "_PAYNM_" which has been deactivated as of "_$$FMTE^XLFDT($P(APPDATA,U,12),"5Z")_".")
175 Q
176 ;
177MULTNAME(TEXT,LIST) ; Function to return an error message with a list of multiple names
178 ; Input parameters:
179 ; TEXT - Error text to display
180 ; LIST - List of items, can be either a list of ins co
181 ; names or National ID names
182 ; Output parameter: Function value - Formatted list of items in 1 string
183 N COLIST,I,NAME,TOOLONG
184 S NAME="",COLIST=TEXT,TOOLONG=0
185 F I=1:1 S NAME=$O(LIST(NAME)) Q:NAME="" D Q:TOOLONG
186 . ; Add this name to the list of found names
187 . I I=1 S COLIST=COLIST_": "_NAME
188 . E S COLIST=COLIST_", "_NAME
189 . ; check if the list of items may cause a MAXSTRING error
190 . I $L(COLIST)<450 Q
191 . S COLIST=COLIST_" (Too many items to display)",TOOLONG=1
192 ;
193 Q COLIST_"."
194 ;
Note: See TracBrowser for help on using the repository browser.