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

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

initial load of FOIAVistA 6/30/08 version
File size: 9.1 KB
Line 
1IBCNEUT3 ;DAOU/AM - IIV MISC. UTILITIES ;12-JUN-2002
2 ;;2.0;INTEGRATED BILLING;**184,252,271**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ; The purpose of the INSERROR utility is to identify a legitimate
6 ; Insurance Company name, returning the associated Payer IEN and
7 ; National ID. This extrinsic function can receive either Insurance or
8 ; Buffer data, identified as TYPE I or B, respectively.
9 ;
10 ; The former is the simpler case. The IEN, in this case the Insurance
11 ; IEN, is validated using the following criteria (some of which is
12 ; validated in routine IBCNEUT4) :
13 ;
14 ; [1] Does it have a National ID?
15 ; [2] Does the National ID have IIV defined?
16 ; [3] Is the Payer active (i.e. the deactivated flag is turned off)
17 ; [4] Is the national connection enabled?
18 ; [5] Is the National ID blocked by VISTA?
19 ;
20 ; If all 5 criteria are met, the Payer IEN and National ID are
21 ; returned. If not, an error is generated and returned in ARRAY with
22 ; information specific to the type of problem encountered.
23 ;
24 ; If the TYPE passed is B for Buffer, the IEN is the Buffer IEN.
25 ; The Insurance Company name is retrieved from the Buffer file and
26 ; leading and trailing spaces are stripped. This value is compared to
27 ; the entries in the "B" cross reference of the Insurance Company file
28 ; (whose values have also been stripped of leading and trailing spaces).
29 ; If a match (or several matches) is found,and a unique National ID is
30 ; identified, confirm the 5 set of insurance validation criteria and
31 ; process as above.
32 ;
33 ; If no match in the Insurance Company could be made, check the Auto
34 ; Match file. If a unique IEN is identified, confirm the 5 set of
35 ; criteria stated above and process in kind.
36 ;
37 ; If no match could be established in both the Insurance Company and the
38 ; Auto Match files, check the insurance company synonym file (stripping
39 ; off leading and trailing spaces) while preserving case sensitivity.
40 ; If a unique Insurance Company could be identified, confirm the 5 set
41 ; of validation criteria and process as above.
42 ;
43 ;
44 ; Can't be called from the top
45 Q
46 ;
47 ;
48INSERROR(TYPE,IEN,ERRFLG,ARRAY) ;
49 ; Formal parameters:
50 ; TYPE: Type of IEN passed in the second parameter.
51 ; Either "B" for "Buffer" or "I" for "Insurance".
52 ; Mandatory, passed by value.
53 ; IEN: IEN to perform a lookup for. Mandatory, passed by value.
54 ; ERRFLG: Error flag. "" or 0 if no extended error information is
55 ; requested, 1 if extended error information is requested.
56 ; Optional (the default is 0), passed by value.
57 ; ARRAY: Array of error messages returned by the function.
58 ; Optional, passed by reference. Whatever is passed in will be
59 ; KILLed by the function. The structure of the return array is
60 ; as follows:
61 ; ARRAY # of error messages passed back
62 ; ARRAY(error#) Data for this error number, including error
63 ; number 1 present in the value returned by the function.
64 ; [1] IEN of the error code in the symbol file
65 ; [2] # of lines in the error message text
66 ; ARRAY(error #,line #) - One line of error message text
67 ; up to 70 characters long
68 ;
69 ; Returned value consists of the following "^"-delimited pcs:
70 ; [1] The IEN of the IIV SYMBOL File (#365.15) entry for
71 ; the first error condition encountered by the function.
72 ; This is only present if a valid Payer was not found.
73 ; [2] Payer IEN if a Payer was found, "" otherwise
74 ; [3] National ID if a Payer was found
75 ;
76 ; Initialize all variables used in this program
77 N INSIEN,INSNAME,NAMEARR,PAYID,PAYIEN,SYMIEN
78 ; Initialize return variables
79 S (PAYID,PAYIEN,SYMIEN)=""
80 ; If the calling program didn't pass the Extended Error flag, init it
81 S ERRFLG=+$G(ERRFLG)
82 ; Initialize array of extended error info to be returned
83 K ARRAY
84 ; Validate input parameters
85 I $G(TYPE)'="B",$G(TYPE)'="I" S SYMIEN=$$ERROR^IBCNEUT8("B9","IEN type "_$G(TYPE)_" passed to the insurance match algorithm is neither 'B' nor 'I'.") G EXIT
86 I $G(IEN)="" S SYMIEN=$$ERROR^IBCNEUT8("B9","IEN is not passed to the insurance match algorithm.") G EXIT
87 I TYPE="B",'$D(^IBA(355.33,IEN)) S SYMIEN=$$ERROR^IBCNEUT8("B9","Invalid Buffer IEN "_IEN_" has been passed to the insurance match algorithm.") G EXIT
88 I TYPE="I",'$D(^DIC(36,IEN)) S SYMIEN=$$ERROR^IBCNEUT8("B9","Invalid Insurance Company IEN "_IEN_" has been passed to the insurance match algorithm.") G EXIT
89 ;
90 ; If the IEN is an Insurance Company IEN, validate it
91 I TYPE="I" D G EXIT
92 . N TMP
93 . ; Check to see if ins co is ACTIVE
94 . S TMP=$$ACTIVE^IBCNEUT4(IEN)
95 . I 'TMP S SYMIEN=$$ERROR^IBCNEUT8("B10","Insurance Company "_$P(TMP,U,2)_" is not active.") Q
96 . D VALID^IBCNEUT4(IEN,.PAYIEN,.PAYID,.SYMIEN)
97 ;
98 ; Retrieve the ins co name from the Ins Buffer
99 S INSNAME=$$TRIM^XLFSTR($P($G(^IBA(355.33,IEN,20)),U,1))
100 I INSNAME="" S SYMIEN=$$ERROR^IBCNEUT8("B13") G EXIT
101 ; Retrieve all ins co IENs matching this ins co name
102 D INSIEN^IBCNEUT8(INSNAME,.INSIEN)
103 ;
104 ; If one or more ins. co. name matches found, retrieve Payer info
105 I $D(INSIEN) D G EXIT
106 . ; If there is one INSIEN - make sure it is ACTIVE
107 . I $O(INSIEN(""))=$O(INSIEN(""),-1),'$$ACTIVE^IBCNEUT4($O(INSIEN(""))) S SYMIEN=$$ERROR^IBCNEUT8("B10","Insurance company "_INSNAME_" is not active.") Q
108 . ; Find National IDs for these ins co IENs
109 . D FINDPAY^IBCNEUT8(.INSIEN,.PAYID)
110 . ; There were Multiple INSIENs - if none exist ALL were INACTIVE
111 . I '$D(INSIEN) S SYMIEN=$$ERROR^IBCNEUT8("B10","All insurance companies named "_INSNAME_" are not active.") Q
112 . ; Quit with an error if no Payer is found for these ins cos
113 . I $O(PAYID(""))="" S SYMIEN=$$ERROR^IBCNEUT8("B4","Insurance company "_INSNAME_" is not linked to a Payer.") Q
114 . ; Quit with an error if more than one Payer found
115 . I $O(PAYID(""))'=$O(PAYID(""),-1) S SYMIEN=$$ERROR^IBCNEUT8("B3","There are multiple Insurance companies named "_INSNAME_" in the Insurance Company file that are linked to more than one Payer",.PAYID),PAYID="" Q
116 . ; Validate the found unique Payer
117 . D VALID^IBCNEUT4(PAYID($O(PAYID(""))),.PAYIEN,.PAYID,.SYMIEN)
118 ;
119 ; If no exact ins co name match was found, check AutoMatch file
120 ; No need to filter out inactives as the AMLOOK will handle it
121 I $$AMLOOK^IBCNEUT1(INSNAME,1,.NAMEARR) D I $D(INSIEN) G EXIT
122 . N NAME
123 . ; Based on the array of ins cos returned by the AutoMatch
124 . ; build an array of ins co IENs that they point to
125 . S NAME="" F S NAME=$O(NAMEARR(NAME)) Q:NAME="" D INSIEN^IBCNEUT8($$TRIM^XLFSTR(NAME),.INSIEN)
126 . ; If nothing found in the Insurance Co x-ref, quit w/o validation
127 . I '$D(INSIEN) Q
128 . ; Check if there is more than one ins co IEN that matches
129 . ; the entered name, in which case exit with an error
130 . I $O(INSIEN(""))'=$O(INSIEN(""),-1) S SYMIEN=$$ERROR^IBCNEUT8("B2","Insurance company name "_INSNAME_" in the Insurance Buffer matched more than one insurance company in the Auto Match file",.NAMEARR) Q
131 . ; Validate the found unique ins co IEN
132 . D VALID^IBCNEUT4($O(INSIEN("")),.PAYIEN,.PAYID,.SYMIEN)
133 ;
134 ; If the first two lookups failed, check the Ins Co Synonym file:
135 ; Retrieve all ins co IENs that match in the Synonym file
136 ;M INSIEN=^DIC(36,"C",INSNAME)
137 N %X,%Y
138 S %X="^DIC(36,""C"",INSNAME,"
139 S %Y="INSIEN("
140 I $D(^DIC(36,"C",INSNAME))#10=1 S INSIEN=^DIC(36,"C",INSNAME)
141 D %XY^%RCR K %X,%Y
142 ;
143 ; If nothing found in the Synonym file, error out
144 I '$D(INSIEN) S SYMIEN=$$ERROR^IBCNEUT8("B1","Insurance company "_INSNAME_" could not be matched to a valid entry in the Insurance Company file.") G EXIT
145 ; Loop thru the ins co IENs that matched in the Synonym file
146 S INSIEN=0 F S INSIEN=$O(INSIEN(INSIEN)) Q:'INSIEN D
147 . N NAME
148 . ; Retrieve the ins co name for this IEN
149 . S NAME=$$TRIM^XLFSTR($P($G(^DIC(36,INSIEN,0)),U,1))
150 . I NAME'="" S NAMEARR(NAME)=""
151 ;
152 ; If more than one ins co name was found, error out
153 I $O(NAMEARR(""))'=$O(NAMEARR(""),-1) D G EXIT
154 . S SYMIEN=$$ERROR^IBCNEUT8("B2","Insurance company name "_INSNAME_" in the Insurance Buffer matched more than one insurance company name in the Synonym cross-reference of the Insurance Company file",.NAMEARR)
155 ;
156 ; If there is one INSIEN - make sure it is ACTIVE
157 I $O(INSIEN(""))=$O(INSIEN(""),-1),'$$ACTIVE^IBCNEUT4($O(INSIEN(""))) S SYMIEN=$$ERROR^IBCNEUT8("B10","Insurance company "_INSNAME_" is not active.") G EXIT
158 ; Find Payers for these ins co IENs
159 D FINDPAY^IBCNEUT8(.INSIEN,.PAYID)
160 ;
161 ; There were Multiple INSIENs - if none exist ALL were INACTIVE
162 I '$D(INSIEN) S SYMIEN=$$ERROR^IBCNEUT8("B10","All insurance companies named "_INSNAME_" are not active."),PAYID="" G EXIT
163 ; If no Payer was found, error out
164 I $O(PAYID(""))="" S SYMIEN=$$ERROR^IBCNEUT8("B4","Insurance company "_$O(NAMEARR(""))_" is not linked to a Payer.") G EXIT
165 ; If multiple Payers were found, error out
166 I $O(PAYID(""))'=$O(PAYID(""),-1) S SYMIEN=$$ERROR^IBCNEUT8("B3","Insurance company "_$O(NAMEARR(""))_" is linked to more than one Payer",.PAYID),PAYID="" G EXIT
167 ; Validate the found unique Payer
168 D VALID^IBCNEUT4(PAYID($O(PAYID(""))),.PAYIEN,.PAYID,.SYMIEN)
169 ;
170EXIT ; Main function exit point
171 Q SYMIEN_U_PAYIEN_U_PAYID
172 ;
Note: See TracBrowser for help on using the repository browser.