- IBCNEUT3 ;DAOU/AM - eIV MISC. UTILITIES ;12-JUN-2002
- ;;2.0;INTEGRATED BILLING;**184,252,271,416,601,713**;21-MAR-94;Build 12
- ;;Per VA Directive 6402, this routine should not be modified.
- ;
- ; The purpose of the INSERROR utility is to identify a legitimate
- ; Insurance Company name, returning the associated Payer IEN and
- ; National ID. This extrinsic function can receive either Insurance or
- ; Buffer data, identified as TYPE I or B, respectively.
- ;
- ; The former is the simpler case. The IEN, in this case the Insurance
- ; IEN, is validated using the following criteria (some of which is
- ; validated in routine IBCNEUT4) :
- ;
- ; [1] Does it have a National ID?
- ; [2] Does the National ID have eIV defined?
- ; [3] Is the Payer active (i.e. the deactivated flag is turned off)
- ; [4] Is the national connection enabled?
- ; [5] Is the National ID blocked by VISTA?
- ;
- ; If all 5 criteria are met, the Payer IEN and National ID are
- ; returned. If not, an error is generated and returned in ARRAY with
- ; information specific to the type of problem encountered.
- ;
- ; If the TYPE passed is B for Buffer, the IEN is the Buffer IEN.
- ; The Insurance Company name is retrieved from the Buffer file and
- ; leading and trailing spaces are stripped. This value is compared to
- ; the entries in the "B" cross reference of the Insurance Company file
- ; (whose values have also been stripped of leading and trailing spaces).
- ; If a match (or several matches) is found,and a unique National ID is
- ; identified, confirm the 5 set of insurance validation criteria and
- ; process as above.
- ;
- ; If no match in the Insurance Company could be made, check the Auto
- ; Match file. If a unique IEN is identified, confirm the 5 set of
- ; criteria stated above and process in kind.
- ;
- ; If no match could be established in both the Insurance Company and the
- ; Auto Match files, check the insurance company synonym file (stripping
- ; off leading and trailing spaces) while preserving case sensitivity.
- ; If a unique Insurance Company could be identified, confirm the 5 set
- ; of validation criteria and process as above.
- ;
- ;
- ; Can't be called from the top
- Q
- ;
- ;
- INSERROR(TYPE,IEN,ERRFLG,ARRAY) ;
- ; Formal parameters:
- ; TYPE: Type of IEN passed in the second parameter.
- ; Either "B" for "Buffer" or "I" for "Insurance".
- ; Mandatory, passed by value.
- ; IEN: IEN to perform a lookup for. Mandatory, passed by value.
- ; ERRFLG: Error flag. "" or 0 if no extended error information is
- ; requested, 1 if extended error information is requested.
- ; Optional (the default is 0), passed by value.
- ; ARRAY: Array of error messages returned by the function.
- ; Optional, passed by reference. Whatever is passed in will be
- ; KILLed by the function. The structure of the return array is
- ; as follows:
- ; ARRAY # of error messages passed back
- ; ARRAY(error#) Data for this error number, including error
- ; number 1 present in the value returned by the function.
- ; [1] IEN of the error code in the symbol file
- ; [2] # of lines in the error message text
- ; ARRAY(error #,line #) - One line of error message text
- ; up to 70 characters long
- ;
- ; Returned value consists of the following "^"-delimited pcs:
- ; [1] The IEN of the IIV SYMBOL File (#365.15) entry for
- ; the first error condition encountered by the function.
- ; This is only present if a valid Payer was not found.
- ; [2] Payer IEN if a Payer was found, "" otherwise
- ; [3] National ID if a Payer was found
- ;
- ; Initialize all variables used in this program
- N INSIEN,INSNAME,NAMEARR,PAYID,PAYIEN,SYMIEN
- ; Initialize return variables
- S (PAYID,PAYIEN,SYMIEN)=""
- ; If the calling program didn't pass the Extended Error flag, init it
- S ERRFLG=+$G(ERRFLG)
- ; Initialize array of extended error info to be returned
- K ARRAY
- ; Validate input parameters
- 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
- I $G(IEN)="" S SYMIEN=$$ERROR^IBCNEUT8("B9","IEN is not passed to the insurance match algorithm.") G EXIT
- 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
- I TYPE="B",$$MBICHK^IBCNEUT7(IEN) Q $$PAYER^IBCNEUT4($$GET1^DIQ(350.9,"1,","MBI PAYER","I")) ; IB*2*601/DM
- I TYPE="B",$$MANUAL(IEN) G EXIT
- 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
- ;
- ; If the IEN is an Insurance Company IEN, validate it
- I TYPE="I" D G EXIT
- . N TMP
- . ; Check to see if ins co is ACTIVE
- . S TMP=$$ACTIVE^IBCNEUT4(IEN)
- . I 'TMP S SYMIEN=$$ERROR^IBCNEUT8("B10","Insurance Company "_$P(TMP,U,2)_" is not active.") Q
- . D VALID^IBCNEUT4(IEN,.PAYIEN,.PAYID,.SYMIEN)
- ;
- ; Retrieve the ins co name from the Ins Buffer
- S INSNAME=$$TRIM^XLFSTR($P($G(^IBA(355.33,IEN,20)),U,1))
- I INSNAME="" S SYMIEN=$$ERROR^IBCNEUT8("B13") G EXIT
- ; Retrieve all ins co IENs matching this ins co name
- D INSIEN^IBCNEUT8(INSNAME,.INSIEN)
- ;
- ; If one or more ins. co. name matches found, retrieve Payer info
- I $D(INSIEN) D G EXIT
- . ; If there is one INSIEN - make sure it is ACTIVE
- . I $O(INSIEN(""))=$O(INSIEN(""),-1),'$$ACTIVE^IBCNEUT4($O(INSIEN(""))) S SYMIEN=$$ERROR^IBCNEUT8("B10","Insurance company "_INSNAME_" is not active.") Q
- . ; Find National IDs for these ins co IENs
- . D FINDPAY^IBCNEUT8(.INSIEN,.PAYID)
- . ; There were Multiple INSIENs - if none exist ALL were INACTIVE
- . I '$D(INSIEN) S SYMIEN=$$ERROR^IBCNEUT8("B10","All insurance companies named "_INSNAME_" are not active.") Q
- . ; Quit with an error if no Payer is found for these ins cos
- . I $O(PAYID(""))="" S SYMIEN=$$ERROR^IBCNEUT8("B4","Insurance company "_INSNAME_" is not linked to a Payer.") Q
- . ; Quit with an error if more than one Payer found
- . 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
- . ; Validate the found unique Payer
- . D VALID^IBCNEUT4(PAYID($O(PAYID(""))),.PAYIEN,.PAYID,.SYMIEN)
- ;
- ; If no exact ins co name match was found, check AutoMatch file
- ; No need to filter out inactives as the AMLOOK will handle it
- I $$AMLOOK^IBCNEUT1(INSNAME,1,.NAMEARR) D I $D(INSIEN) G EXIT
- . N NAME
- . ; Based on the array of ins cos returned by the AutoMatch
- . ; build an array of ins co IENs that they point to
- . S NAME="" F S NAME=$O(NAMEARR(NAME)) Q:NAME="" D INSIEN^IBCNEUT8($$TRIM^XLFSTR(NAME),.INSIEN)
- . ; If nothing found in the Insurance Co x-ref, quit w/o validation
- . I '$D(INSIEN) Q
- . ; Check if there is more than one ins co IEN that matches
- . ; the entered name, in which case exit with an error
- . 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
- . ; Validate the found unique ins co IEN
- . D VALID^IBCNEUT4($O(INSIEN("")),.PAYIEN,.PAYID,.SYMIEN)
- ;
- ; If the first two lookups failed, check the Ins Co Synonym file:
- ; Retrieve all ins co IENs that match in the Synonym file
- M INSIEN=^DIC(36,"C",INSNAME)
- ;
- ; If nothing found in the Synonym file, error out
- 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
- ; Loop thru the ins co IENs that matched in the Synonym file
- S INSIEN=0 F S INSIEN=$O(INSIEN(INSIEN)) Q:'INSIEN D
- . N NAME
- . ; Retrieve the ins co name for this IEN
- . S NAME=$$TRIM^XLFSTR($P($G(^DIC(36,INSIEN,0)),U,1))
- . I NAME'="" S NAMEARR(NAME)=""
- ;
- ; If more than one ins co name was found, error out
- I $O(NAMEARR(""))'=$O(NAMEARR(""),-1) D G EXIT
- . 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)
- ;
- ; If there is one INSIEN - make sure it is ACTIVE
- I $O(INSIEN(""))=$O(INSIEN(""),-1),'$$ACTIVE^IBCNEUT4($O(INSIEN(""))) S SYMIEN=$$ERROR^IBCNEUT8("B10","Insurance company "_INSNAME_" is not active.") G EXIT
- ; Find Payers for these ins co IENs
- D FINDPAY^IBCNEUT8(.INSIEN,.PAYID)
- ;
- ; There were Multiple INSIENs - if none exist ALL were INACTIVE
- I '$D(INSIEN) S SYMIEN=$$ERROR^IBCNEUT8("B10","All insurance companies named "_INSNAME_" are not active."),PAYID="" G EXIT
- ; If no Payer was found, error out
- I $O(PAYID(""))="" S SYMIEN=$$ERROR^IBCNEUT8("B4","Insurance company "_$O(NAMEARR(""))_" is not linked to a Payer.") G EXIT
- ; If multiple Payers were found, error out
- 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
- ; Validate the found unique Payer
- D VALID^IBCNEUT4(PAYID($O(PAYID(""))),.PAYIEN,.PAYID,.SYMIEN)
- ;
- EXIT ; Main function exit point
- Q SYMIEN_U_PAYIEN_U_PAYID
- ;
- MANUAL(IEN) ; Need to do a manual insurance verification?
- N MANUAL,STIEN
- S MANUAL=0
- S STIEN=$$FIND1^DIC(365.15,,"X","B17","B")
- I $$GET1^DIQ(355.33,IEN_",",.12,"I")=STIEN S MANUAL=1,SYMIEN=STIEN
- Q MANUAL
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNEUT3 9732 printed Feb 18, 2025@23:41:56 Page 2
- IBCNEUT3 ;DAOU/AM - eIV MISC. UTILITIES ;12-JUN-2002
- +1 ;;2.0;INTEGRATED BILLING;**184,252,271,416,601,713**;21-MAR-94;Build 12
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- +4 ; The purpose of the INSERROR utility is to identify a legitimate
- +5 ; Insurance Company name, returning the associated Payer IEN and
- +6 ; National ID. This extrinsic function can receive either Insurance or
- +7 ; Buffer data, identified as TYPE I or B, respectively.
- +8 ;
- +9 ; The former is the simpler case. The IEN, in this case the Insurance
- +10 ; IEN, is validated using the following criteria (some of which is
- +11 ; validated in routine IBCNEUT4) :
- +12 ;
- +13 ; [1] Does it have a National ID?
- +14 ; [2] Does the National ID have eIV defined?
- +15 ; [3] Is the Payer active (i.e. the deactivated flag is turned off)
- +16 ; [4] Is the national connection enabled?
- +17 ; [5] Is the National ID blocked by VISTA?
- +18 ;
- +19 ; If all 5 criteria are met, the Payer IEN and National ID are
- +20 ; returned. If not, an error is generated and returned in ARRAY with
- +21 ; information specific to the type of problem encountered.
- +22 ;
- +23 ; If the TYPE passed is B for Buffer, the IEN is the Buffer IEN.
- +24 ; The Insurance Company name is retrieved from the Buffer file and
- +25 ; leading and trailing spaces are stripped. This value is compared to
- +26 ; the entries in the "B" cross reference of the Insurance Company file
- +27 ; (whose values have also been stripped of leading and trailing spaces).
- +28 ; If a match (or several matches) is found,and a unique National ID is
- +29 ; identified, confirm the 5 set of insurance validation criteria and
- +30 ; process as above.
- +31 ;
- +32 ; If no match in the Insurance Company could be made, check the Auto
- +33 ; Match file. If a unique IEN is identified, confirm the 5 set of
- +34 ; criteria stated above and process in kind.
- +35 ;
- +36 ; If no match could be established in both the Insurance Company and the
- +37 ; Auto Match files, check the insurance company synonym file (stripping
- +38 ; off leading and trailing spaces) while preserving case sensitivity.
- +39 ; If a unique Insurance Company could be identified, confirm the 5 set
- +40 ; of validation criteria and process as above.
- +41 ;
- +42 ;
- +43 ; Can't be called from the top
- +44 QUIT
- +45 ;
- +46 ;
- INSERROR(TYPE,IEN,ERRFLG,ARRAY) ;
- +1 ; Formal parameters:
- +2 ; TYPE: Type of IEN passed in the second parameter.
- +3 ; Either "B" for "Buffer" or "I" for "Insurance".
- +4 ; Mandatory, passed by value.
- +5 ; IEN: IEN to perform a lookup for. Mandatory, passed by value.
- +6 ; ERRFLG: Error flag. "" or 0 if no extended error information is
- +7 ; requested, 1 if extended error information is requested.
- +8 ; Optional (the default is 0), passed by value.
- +9 ; ARRAY: Array of error messages returned by the function.
- +10 ; Optional, passed by reference. Whatever is passed in will be
- +11 ; KILLed by the function. The structure of the return array is
- +12 ; as follows:
- +13 ; ARRAY # of error messages passed back
- +14 ; ARRAY(error#) Data for this error number, including error
- +15 ; number 1 present in the value returned by the function.
- +16 ; [1] IEN of the error code in the symbol file
- +17 ; [2] # of lines in the error message text
- +18 ; ARRAY(error #,line #) - One line of error message text
- +19 ; up to 70 characters long
- +20 ;
- +21 ; Returned value consists of the following "^"-delimited pcs:
- +22 ; [1] The IEN of the IIV SYMBOL File (#365.15) entry for
- +23 ; the first error condition encountered by the function.
- +24 ; This is only present if a valid Payer was not found.
- +25 ; [2] Payer IEN if a Payer was found, "" otherwise
- +26 ; [3] National ID if a Payer was found
- +27 ;
- +28 ; Initialize all variables used in this program
- +29 NEW INSIEN,INSNAME,NAMEARR,PAYID,PAYIEN,SYMIEN
- +30 ; Initialize return variables
- +31 SET (PAYID,PAYIEN,SYMIEN)=""
- +32 ; If the calling program didn't pass the Extended Error flag, init it
- +33 SET ERRFLG=+$GET(ERRFLG)
- +34 ; Initialize array of extended error info to be returned
- +35 KILL ARRAY
- +36 ; Validate input parameters
- +37 IF $GET(TYPE)'="B"
- IF $GET(TYPE)'="I"
- SET SYMIEN=$$ERROR^IBCNEUT8("B9","IEN type "_$GET(TYPE)_" passed to the insurance match algorithm is neither 'B' nor 'I'.")
- GOTO EXIT
- +38 IF $GET(IEN)=""
- SET SYMIEN=$$ERROR^IBCNEUT8("B9","IEN is not passed to the insurance match algorithm.")
- GOTO EXIT
- +39 IF TYPE="B"
- IF '$DATA(^IBA(355.33,IEN))
- SET SYMIEN=$$ERROR^IBCNEUT8("B9","Invalid Buffer IEN "_IEN_" has been passed to the insurance match algorithm.")
- GOTO EXIT
- +40 ; IB*2*601/DM
- IF TYPE="B"
- IF $$MBICHK^IBCNEUT7(IEN)
- QUIT $$PAYER^IBCNEUT4($$GET1^DIQ(350.9,"1,","MBI PAYER","I"))
- +41 IF TYPE="B"
- IF $$MANUAL(IEN)
- GOTO EXIT
- +42 IF TYPE="I"
- IF '$DATA(^DIC(36,IEN))
- SET SYMIEN=$$ERROR^IBCNEUT8("B9","Invalid Insurance Company IEN "_IEN_" has been passed to the insurance match algorithm.")
- GOTO EXIT
- +43 ;
- +44 ; If the IEN is an Insurance Company IEN, validate it
- +45 IF TYPE="I"
- Begin DoDot:1
- +46 NEW TMP
- +47 ; Check to see if ins co is ACTIVE
- +48 SET TMP=$$ACTIVE^IBCNEUT4(IEN)
- +49 IF 'TMP
- SET SYMIEN=$$ERROR^IBCNEUT8("B10","Insurance Company "_$PIECE(TMP,U,2)_" is not active.")
- QUIT
- +50 DO VALID^IBCNEUT4(IEN,.PAYIEN,.PAYID,.SYMIEN)
- End DoDot:1
- GOTO EXIT
- +51 ;
- +52 ; Retrieve the ins co name from the Ins Buffer
- +53 SET INSNAME=$$TRIM^XLFSTR($PIECE($GET(^IBA(355.33,IEN,20)),U,1))
- +54 IF INSNAME=""
- SET SYMIEN=$$ERROR^IBCNEUT8("B13")
- GOTO EXIT
- +55 ; Retrieve all ins co IENs matching this ins co name
- +56 DO INSIEN^IBCNEUT8(INSNAME,.INSIEN)
- +57 ;
- +58 ; If one or more ins. co. name matches found, retrieve Payer info
- +59 IF $DATA(INSIEN)
- Begin DoDot:1
- +60 ; If there is one INSIEN - make sure it is ACTIVE
- +61 IF $ORDER(INSIEN(""))=$ORDER(INSIEN(""),-1)
- IF '$$ACTIVE^IBCNEUT4($ORDER(INSIEN("")))
- SET SYMIEN=$$ERROR^IBCNEUT8("B10","Insurance company "_INSNAME_" is not active.")
- QUIT
- +62 ; Find National IDs for these ins co IENs
- +63 DO FINDPAY^IBCNEUT8(.INSIEN,.PAYID)
- +64 ; There were Multiple INSIENs - if none exist ALL were INACTIVE
- +65 IF '$DATA(INSIEN)
- SET SYMIEN=$$ERROR^IBCNEUT8("B10","All insurance companies named "_INSNAME_" are not active.")
- QUIT
- +66 ; Quit with an error if no Payer is found for these ins cos
- +67 IF $ORDER(PAYID(""))=""
- SET SYMIEN=$$ERROR^IBCNEUT8("B4","Insurance company "_INSNAME_" is not linked to a Payer.")
- QUIT
- +68 ; Quit with an error if more than one Payer found
- +69 IF $ORDER(PAYID(""))'=$ORDER(PAYID(""),-1)
- SET 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)
- SET PAYID=""
- QUIT
- +70 ; Validate the found unique Payer
- +71 DO VALID^IBCNEUT4(PAYID($ORDER(PAYID(""))),.PAYIEN,.PAYID,.SYMIEN)
- End DoDot:1
- GOTO EXIT
- +72 ;
- +73 ; If no exact ins co name match was found, check AutoMatch file
- +74 ; No need to filter out inactives as the AMLOOK will handle it
- +75 IF $$AMLOOK^IBCNEUT1(INSNAME,1,.NAMEARR)
- Begin DoDot:1
- +76 NEW NAME
- +77 ; Based on the array of ins cos returned by the AutoMatch
- +78 ; build an array of ins co IENs that they point to
- +79 SET NAME=""
- FOR
- SET NAME=$ORDER(NAMEARR(NAME))
- if NAME=""
- QUIT
- DO INSIEN^IBCNEUT8($$TRIM^XLFSTR(NAME),.INSIEN)
- +80 ; If nothing found in the Insurance Co x-ref, quit w/o validation
- +81 IF '$DATA(INSIEN)
- QUIT
- +82 ; Check if there is more than one ins co IEN that matches
- +83 ; the entered name, in which case exit with an error
- +84 IF $ORDER(INSIEN(""))'=$ORDER(INSIEN(""),-1)
- SET SYMIEN=$$ERROR^IBCNEUT8("B2","Insurance company name "_INSNAME_" in the Insurance Buffer matched more than one insurance company in the Auto Match file",.NAMEARR)
- QUIT
- +85 ; Validate the found unique ins co IEN
- +86 DO VALID^IBCNEUT4($ORDER(INSIEN("")),.PAYIEN,.PAYID,.SYMIEN)
- End DoDot:1
- IF $DATA(INSIEN)
- GOTO EXIT
- +87 ;
- +88 ; If the first two lookups failed, check the Ins Co Synonym file:
- +89 ; Retrieve all ins co IENs that match in the Synonym file
- +90 MERGE INSIEN=^DIC(36,"C",INSNAME)
- +91 ;
- +92 ; If nothing found in the Synonym file, error out
- +93 IF '$DATA(INSIEN)
- SET SYMIEN=$$ERROR^IBCNEUT8("B1","Insurance company "_INSNAME_" could not be matched to a valid entry in the Insurance Company file.")
- GOTO EXIT
- +94 ; Loop thru the ins co IENs that matched in the Synonym file
- +95 SET INSIEN=0
- FOR
- SET INSIEN=$ORDER(INSIEN(INSIEN))
- if 'INSIEN
- QUIT
- Begin DoDot:1
- +96 NEW NAME
- +97 ; Retrieve the ins co name for this IEN
- +98 SET NAME=$$TRIM^XLFSTR($PIECE($GET(^DIC(36,INSIEN,0)),U,1))
- +99 IF NAME'=""
- SET NAMEARR(NAME)=""
- End DoDot:1
- +100 ;
- +101 ; If more than one ins co name was found, error out
- +102 IF $ORDER(NAMEARR(""))'=$ORDER(NAMEARR(""),-1)
- Begin DoDot:1
- +103 SET 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)
- End DoDot:1
- GOTO EXIT
- +104 ;
- +105 ; If there is one INSIEN - make sure it is ACTIVE
- +106 IF $ORDER(INSIEN(""))=$ORDER(INSIEN(""),-1)
- IF '$$ACTIVE^IBCNEUT4($ORDER(INSIEN("")))
- SET SYMIEN=$$ERROR^IBCNEUT8("B10","Insurance company "_INSNAME_" is not active.")
- GOTO EXIT
- +107 ; Find Payers for these ins co IENs
- +108 DO FINDPAY^IBCNEUT8(.INSIEN,.PAYID)
- +109 ;
- +110 ; There were Multiple INSIENs - if none exist ALL were INACTIVE
- +111 IF '$DATA(INSIEN)
- SET SYMIEN=$$ERROR^IBCNEUT8("B10","All insurance companies named "_INSNAME_" are not active.")
- SET PAYID=""
- GOTO EXIT
- +112 ; If no Payer was found, error out
- +113 IF $ORDER(PAYID(""))=""
- SET SYMIEN=$$ERROR^IBCNEUT8("B4","Insurance company "_$ORDER(NAMEARR(""))_" is not linked to a Payer.")
- GOTO EXIT
- +114 ; If multiple Payers were found, error out
- +115 IF $ORDER(PAYID(""))'=$ORDER(PAYID(""),-1)
- SET SYMIEN=$$ERROR^IBCNEUT8("B3","Insurance company "_$ORDER(NAMEARR(""))_" is linked to more than one Payer",.PAYID)
- SET PAYID=""
- GOTO EXIT
- +116 ; Validate the found unique Payer
- +117 DO VALID^IBCNEUT4(PAYID($ORDER(PAYID(""))),.PAYIEN,.PAYID,.SYMIEN)
- +118 ;
- EXIT ; Main function exit point
- +1 QUIT SYMIEN_U_PAYIEN_U_PAYID
- +2 ;
- MANUAL(IEN) ; Need to do a manual insurance verification?
- +1 NEW MANUAL,STIEN
- +2 SET MANUAL=0
- +3 SET STIEN=$$FIND1^DIC(365.15,,"X","B17","B")
- +4 IF $$GET1^DIQ(355.33,IEN_",",.12,"I")=STIEN
- SET MANUAL=1
- SET SYMIEN=STIEN
- +5 QUIT MANUAL