- IBCNEUT4 ;DAOU/ESG - eIV MISC. UTILITIES ;17-JUN-2002
- ;;2.0;INTEGRATED BILLING;**184,271,345,416,497,601,668**;21-MAR-94;Build 28
- ;;Per VA Directive 6402, this routine should not be modified.
- ;
- ; Can't be called from the top
- Q
- ;
- ;
- ACTIVE(INSDA) ; Is this insurance company currently active? 1:yes or 0:no
- ; Insurance company name returned in the second piece.
- ; Input: INSDA - insurance company ien
- NEW ACTFLG,INSDATA
- S ACTFLG=0 ; default inactive
- I '$G(INSDA) G ACTIVEX ; bad data passed in
- S INSDATA=$G(^DIC(36,INSDA,0)) ; zero node of File 36
- I INSDATA="" G ACTIVEX ; bad record
- I $P(INSDATA,U,5) G ACTIVEX ; INACTIVE flag is true
- I $P($G(^DIC(36,INSDA,5)),U,1) G ACTIVEX ; SCHEDULED FOR DELETION flag is true
- S ACTFLG=1 ; Otherwise, its active
- ACTIVEX ;
- Q ACTFLG_U_$P($G(^DIC(36,+$G(INSDA),0)),U,1)
- ;
- ;
- EXCLUDE(NAME) ; This function determines if we should exclude the insurance
- ; company based on the name.
- ; This function returns 1 if we should exclude the insurance company.
- ; This function returns 0 if we should not exclude it (i.e. include it)
- ;
- ; Initialize flag; default to not exclude it
- NEW EXCL
- S EXCL=0
- ;
- ; Screen out bad data
- I $G(NAME)="" S EXCL=1 G EXCLUDX
- ;
- ; Screen out MEDICAID ins co
- I NAME["MEDICAID" S EXCL=1
- EXCLUDX ;
- Q EXCL
- ;
- ;
- CLEAR(DA,EDITED,FORCE) ; This procedure will clear the eIV status field from an
- ; Insurance Buffer entry (pass in the internal entry number of the
- ; buffer entry). If the FORCE variable is not passed then the eIV
- ; status will only be cleared if the existing status is an error status
- ;
- ; Parameters
- ; DA - required input parameter; buffer ien
- ; EDITED - optional output parameter; this will tell you if the
- ; buffer symbol was cleared
- ; FORCE - optional input parameter; if this is set to 1 then the
- ; eIV status field will be cleared regardless of the
- ; current status
- NEW DIE,DR,D,D0,DI,DIC,DISYS,DQ,X,%
- I '$G(DA) G CLEARX
- I '$D(FORCE) S FORCE=0
- I 'FORCE,$$SYMBOL^IBCNBLL(DA)'="!" G CLEARX
- S DIE=355.33,DR=".12///@"
- D ^DIE
- S EDITED=1
- CLEARX ;
- Q
- ;
- ;
- INFO(IBBUFDA) ; Return original and current buffer data
- ; This procedure will retrieve the following data from the buffer and
- ; from the transmission queue file. The buffer holds the current data
- ; and the TQ file holds the original buffer data.
- ; Input
- ; IBBUFDA - buffer internal entry number
- ; Output
- ; a pieced string as follows
- ; [1] Has this buffer entry been transmitted? 1/0
- ; [2] Current buffer source of information (external)
- ; [3] Current buffer source of information (internal)
- ; [4] Current buffer insurance company name
- ; [5] Current buffer group number
- ; [6] Current buffer group name
- ; [7] Current buffer subscriber ID
- ; [8] Original buffer insurance company name
- ; [9] Original buffer group number
- ; [10] Original buffer group name
- ; [11] Original buffer subscriber ID
- ;
- NEW IB0,IB20,IB90,DATA,RESPIEN,FOUND,TQIEN,TQDATA,TQDATA1,DISYS
- S DATA=""
- I '$G(IBBUFDA) G INFOX
- I '$D(^IBA(355.33,IBBUFDA)) G INFOX
- S IB0=$G(^IBA(355.33,IBBUFDA,0))
- S IB20=$G(^IBA(355.33,IBBUFDA,20))
- S IB90=$G(^IBA(355.33,IBBUFDA,90)) ; IB*2.0*497 (vd)
- S $P(DATA,U,1)=0 ; default to not been transmitted
- S $P(DATA,U,2)=$$EXTERNAL^DILFD(355.33,.03,"",$P(IB0,U,3)) ; source
- S $P(DATA,U,3)=$P(IB0,U,3) ; internal source
- S $P(DATA,U,4)=$P(IB20,U,1) ; insurance company name
- S $P(DATA,U,5)=$P(IB90,U,2) ; group number - IB*2.0*497 (vd)
- S $P(DATA,U,6)=$P(IB90,U,1) ; group name - IB*2.0*497 (vd)
- S $P(DATA,U,7)=$P(IB90,U,3) ; subscriber id - IB*2.0*497 (vd)
- ;
- ; Look at the response file and the transmission queue file. Since
- ; we're trying to get the original data look at the oldest data first.
- S RESPIEN=0,FOUND=0
- F S RESPIEN=$O(^IBCN(365,"AF",IBBUFDA,RESPIEN)) Q:'RESPIEN D Q:FOUND
- . S TQIEN=$P($G(^IBCN(365,RESPIEN,0)),U,5)
- . I 'TQIEN Q
- . S TQDATA=$G(^IBCN(365.1,TQIEN,0))
- . S TQDATA1=$G(^IBCN(365.1,TQIEN,1))
- . I TQDATA="" Q
- . S $P(DATA,U,8)=$P(TQDATA1,U,2) ; insurance company name
- . S $P(DATA,U,9)=$P(TQDATA1,U,3) ; group number
- . S $P(DATA,U,10)=$P(TQDATA1,U,4) ; group name
- . S $P(DATA,U,11)=$P(TQDATA1,U,5) ; subscriber id
- . S FOUND=1 ; Stop once we have some data
- . Q
- ;
- I FOUND S $P(DATA,U,1)=1
- INFOX ;
- Q DATA
- ;
- ;
- VALID(INSIEN,PAYIEN,PAYID,SYMIEN) ; Validate an Ins Co IEN
- ; Input parameter: INSIEN - Ins co IEN, passed by value
- ; Output parameters: PAYIEN, PAYID, SYMIEN, passed by reference
- N APPDATA,APPIEN,INSNAME
- ; Retrieve the Ins Co name
- S INSNAME=$P($G(^DIC(36,INSIEN,0)),U,1)
- I INSNAME="" S SYMIEN=$$ERROR^IBCNEUT8("B9","Insurance company IEN "_INSIEN_" doesn't have a name on file.") G VALIDX
- ; Screen out MEDICAID ins co
- I $$EXCLUDE(INSNAME) S SYMIEN=$$ERROR^IBCNEUT8("B11","Insurance company "_INSNAME_" contains MEDICAID in the name. Electronic inquiries cannot be made to this insurance company.") G VALIDX
- ; Retrieve the Payer IEN associated with this ins co
- S PAYIEN=$P($G(^DIC(36,INSIEN,3)),U,10)
- I PAYIEN="" S SYMIEN=$$ERROR^IBCNEUT8("B4","Insurance company "_INSNAME_" is not linked to a Payer.") G VALIDX
- D VALPYR(INSNAME) ; Payer val'n
- VALIDX ;
- Q
- ;
- PAYER(PAYIEN) ;
- ; Entry pt for Most Pop Payer (called by POP^IBCNEDE4)
- ; IB*2*601/DM comments and adjust return to add PAYIEN
- ; Additionally, called from INSERROR^IBCNEUT3() for MBI Inquiries
- ; 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
- N SYMIEN,PAYID
- N APPDATA,APPIEN ; Set within tag VALPYR these variables are never
- ; killed. Using tag VALID's method of NEWing variables
- ; first will allow them to be killed appropriately.
- N ARRAY ; This is an array that is set by ERROR^IBCNEUT8 but never
- ; killed. When there is a most popular payer that is not
- ; eligible for inquiries, ARRAY would continue to grow.
- S (SYMIEN,PAYID)=""
- D VALPYR("")
- Q SYMIEN_U_PAYIEN_U_PAYID
- ;
- VALPYR(INSNM) ;
- ; Payer Val'n - note: PAYIEN (payer IEN) must be set
- ; If INSNM="" val'n is for Most Pop Payer
- N DEACT,PAYNM
- ;
- S INSNM=$G(INSNM) ; Init variable if not passed
- ; Retrieve the National ID(Payer ID) for this Payer IEN
- S PAYID=$P($G(^IBE(365.12,PAYIEN,0)),U,2)
- I PAYID="" S SYMIEN=$$ERROR^IBCNEUT8("B9","Payer IEN "_PAYIEN_" does not have a Payer.") Q
- ; Retrieve payer name
- S PAYNM=$P($G(^IBE(365.12,PAYIEN,0)),U,1)
- ; Retrieve the IEN of the eIV Application
- ;IB*668/TAZ - Changed Payer Application from IIV to EIV
- S APPIEN=$$PYRAPP^IBCNEUT5("EIV",PAYIEN)
- I APPIEN="" S SYMIEN=$$ERROR^IBCNEUT8("B9","The eIV Payer Application has not been created for this site.") Q
- ; Verify the existence of the application for this Payer
- 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
- ; Retrieve the eIV-specific application data for this Payer
- S APPDATA=$G(^IBE(365.12,PAYIEN,1,APPIEN,0))
- ;IB*668/DW - Update comment and error text to reflect change from 'national/local active' to 'nationally/locally enabled'
- ; Check the Payer's national enabled status and local enabled status. If the payer is not both
- ; enabled for both then return one or, if applicable, BOTH errors
- ;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.")
- ;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.")
- I '$P(APPDATA,U,3) S SYMIEN=$$ERROR^IBCNEUT8("B6","Insurance company "_INSNM_" is linked to Payer "_PAYNM_" which is not locally enabled for eIV.")
- I '$P(APPDATA,U,2) S SYMIEN=$$ERROR^IBCNEUT8("B5","Insurance company "_INSNM_" is linked to Payer "_PAYNM_" which is not nationally enabled for eIV.")
- ;IB*668/TAZ - Call PYRDEACT to get Payer Deactivated from new file location.
- ; Check if the Payer has been deactivated, if so report it
- S DEACT=$$PYRDEACT^IBCNINSU(PAYIEN)
- I +DEACT S SYMIEN=$$ERROR^IBCNEUT8("B14","Insurance company "_INSNM_" is linked to Payer "_PAYNM_" which has been deactivated as of "_$$FMTE^XLFDT($P(DEACT,U,2),"5Z")_".")
- Q
- ;
- MULTNAME(TEXT,LIST) ; Function to return an error message with a list of multiple names
- ; Input parameters:
- ; TEXT - Error text to display
- ; LIST - List of items, can be either a list of ins co
- ; names or National ID names
- ; Output parameter: Function value - Formatted list of items in 1 string
- N COLIST,I,NAME,TOOLONG
- S NAME="",COLIST=TEXT,TOOLONG=0
- F I=1:1 S NAME=$O(LIST(NAME)) Q:NAME="" D Q:TOOLONG
- . ; Add this name to the list of found names
- . I I=1 S COLIST=COLIST_": "_NAME
- . E S COLIST=COLIST_", "_NAME
- . ; check if the list of items may cause a MAXSTRING error
- . I $L(COLIST)<450 Q
- . S COLIST=COLIST_" (Too many items to display)",TOOLONG=1
- ;
- Q COLIST_"."
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNEUT4 9629 printed Feb 18, 2025@23:41:57 Page 2
- IBCNEUT4 ;DAOU/ESG - eIV MISC. UTILITIES ;17-JUN-2002
- +1 ;;2.0;INTEGRATED BILLING;**184,271,345,416,497,601,668**;21-MAR-94;Build 28
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- +4 ; Can't be called from the top
- +5 QUIT
- +6 ;
- +7 ;
- ACTIVE(INSDA) ; Is this insurance company currently active? 1:yes or 0:no
- +1 ; Insurance company name returned in the second piece.
- +2 ; Input: INSDA - insurance company ien
- +3 NEW ACTFLG,INSDATA
- +4 ; default inactive
- SET ACTFLG=0
- +5 ; bad data passed in
- IF '$GET(INSDA)
- GOTO ACTIVEX
- +6 ; zero node of File 36
- SET INSDATA=$GET(^DIC(36,INSDA,0))
- +7 ; bad record
- IF INSDATA=""
- GOTO ACTIVEX
- +8 ; INACTIVE flag is true
- IF $PIECE(INSDATA,U,5)
- GOTO ACTIVEX
- +9 ; SCHEDULED FOR DELETION flag is true
- IF $PIECE($GET(^DIC(36,INSDA,5)),U,1)
- GOTO ACTIVEX
- +10 ; Otherwise, its active
- SET ACTFLG=1
- ACTIVEX ;
- +1 QUIT ACTFLG_U_$PIECE($GET(^DIC(36,+$GET(INSDA),0)),U,1)
- +2 ;
- +3 ;
- EXCLUDE(NAME) ; This function determines if we should exclude the insurance
- +1 ; company based on the name.
- +2 ; This function returns 1 if we should exclude the insurance company.
- +3 ; This function returns 0 if we should not exclude it (i.e. include it)
- +4 ;
- +5 ; Initialize flag; default to not exclude it
- +6 NEW EXCL
- +7 SET EXCL=0
- +8 ;
- +9 ; Screen out bad data
- +10 IF $GET(NAME)=""
- SET EXCL=1
- GOTO EXCLUDX
- +11 ;
- +12 ; Screen out MEDICAID ins co
- +13 IF NAME["MEDICAID"
- SET EXCL=1
- EXCLUDX ;
- +1 QUIT EXCL
- +2 ;
- +3 ;
- CLEAR(DA,EDITED,FORCE) ; This procedure will clear the eIV status field from an
- +1 ; Insurance Buffer entry (pass in the internal entry number of the
- +2 ; buffer entry). If the FORCE variable is not passed then the eIV
- +3 ; status will only be cleared if the existing status is an error status
- +4 ;
- +5 ; Parameters
- +6 ; DA - required input parameter; buffer ien
- +7 ; EDITED - optional output parameter; this will tell you if the
- +8 ; buffer symbol was cleared
- +9 ; FORCE - optional input parameter; if this is set to 1 then the
- +10 ; eIV status field will be cleared regardless of the
- +11 ; current status
- +12 NEW DIE,DR,D,D0,DI,DIC,DISYS,DQ,X,%
- +13 IF '$GET(DA)
- GOTO CLEARX
- +14 IF '$DATA(FORCE)
- SET FORCE=0
- +15 IF 'FORCE
- IF $$SYMBOL^IBCNBLL(DA)'="!"
- GOTO CLEARX
- +16 SET DIE=355.33
- SET DR=".12///@"
- +17 DO ^DIE
- +18 SET EDITED=1
- CLEARX ;
- +1 QUIT
- +2 ;
- +3 ;
- INFO(IBBUFDA) ; Return original and current buffer data
- +1 ; This procedure will retrieve the following data from the buffer and
- +2 ; from the transmission queue file. The buffer holds the current data
- +3 ; and the TQ file holds the original buffer data.
- +4 ; Input
- +5 ; IBBUFDA - buffer internal entry number
- +6 ; Output
- +7 ; a pieced string as follows
- +8 ; [1] Has this buffer entry been transmitted? 1/0
- +9 ; [2] Current buffer source of information (external)
- +10 ; [3] Current buffer source of information (internal)
- +11 ; [4] Current buffer insurance company name
- +12 ; [5] Current buffer group number
- +13 ; [6] Current buffer group name
- +14 ; [7] Current buffer subscriber ID
- +15 ; [8] Original buffer insurance company name
- +16 ; [9] Original buffer group number
- +17 ; [10] Original buffer group name
- +18 ; [11] Original buffer subscriber ID
- +19 ;
- +20 NEW IB0,IB20,IB90,DATA,RESPIEN,FOUND,TQIEN,TQDATA,TQDATA1,DISYS
- +21 SET DATA=""
- +22 IF '$GET(IBBUFDA)
- GOTO INFOX
- +23 IF '$DATA(^IBA(355.33,IBBUFDA))
- GOTO INFOX
- +24 SET IB0=$GET(^IBA(355.33,IBBUFDA,0))
- +25 SET IB20=$GET(^IBA(355.33,IBBUFDA,20))
- +26 ; IB*2.0*497 (vd)
- SET IB90=$GET(^IBA(355.33,IBBUFDA,90))
- +27 ; default to not been transmitted
- SET $PIECE(DATA,U,1)=0
- +28 ; source
- SET $PIECE(DATA,U,2)=$$EXTERNAL^DILFD(355.33,.03,"",$PIECE(IB0,U,3))
- +29 ; internal source
- SET $PIECE(DATA,U,3)=$PIECE(IB0,U,3)
- +30 ; insurance company name
- SET $PIECE(DATA,U,4)=$PIECE(IB20,U,1)
- +31 ; group number - IB*2.0*497 (vd)
- SET $PIECE(DATA,U,5)=$PIECE(IB90,U,2)
- +32 ; group name - IB*2.0*497 (vd)
- SET $PIECE(DATA,U,6)=$PIECE(IB90,U,1)
- +33 ; subscriber id - IB*2.0*497 (vd)
- SET $PIECE(DATA,U,7)=$PIECE(IB90,U,3)
- +34 ;
- +35 ; Look at the response file and the transmission queue file. Since
- +36 ; we're trying to get the original data look at the oldest data first.
- +37 SET RESPIEN=0
- SET FOUND=0
- +38 FOR
- SET RESPIEN=$ORDER(^IBCN(365,"AF",IBBUFDA,RESPIEN))
- if 'RESPIEN
- QUIT
- Begin DoDot:1
- +39 SET TQIEN=$PIECE($GET(^IBCN(365,RESPIEN,0)),U,5)
- +40 IF 'TQIEN
- QUIT
- +41 SET TQDATA=$GET(^IBCN(365.1,TQIEN,0))
- +42 SET TQDATA1=$GET(^IBCN(365.1,TQIEN,1))
- +43 IF TQDATA=""
- QUIT
- +44 ; insurance company name
- SET $PIECE(DATA,U,8)=$PIECE(TQDATA1,U,2)
- +45 ; group number
- SET $PIECE(DATA,U,9)=$PIECE(TQDATA1,U,3)
- +46 ; group name
- SET $PIECE(DATA,U,10)=$PIECE(TQDATA1,U,4)
- +47 ; subscriber id
- SET $PIECE(DATA,U,11)=$PIECE(TQDATA1,U,5)
- +48 ; Stop once we have some data
- SET FOUND=1
- +49 QUIT
- End DoDot:1
- if FOUND
- QUIT
- +50 ;
- +51 IF FOUND
- SET $PIECE(DATA,U,1)=1
- INFOX ;
- +1 QUIT DATA
- +2 ;
- +3 ;
- VALID(INSIEN,PAYIEN,PAYID,SYMIEN) ; Validate an Ins Co IEN
- +1 ; Input parameter: INSIEN - Ins co IEN, passed by value
- +2 ; Output parameters: PAYIEN, PAYID, SYMIEN, passed by reference
- +3 NEW APPDATA,APPIEN,INSNAME
- +4 ; Retrieve the Ins Co name
- +5 SET INSNAME=$PIECE($GET(^DIC(36,INSIEN,0)),U,1)
- +6 IF INSNAME=""
- SET SYMIEN=$$ERROR^IBCNEUT8("B9","Insurance company IEN "_INSIEN_" doesn't have a name on file.")
- GOTO VALIDX
- +7 ; Screen out MEDICAID ins co
- +8 IF $$EXCLUDE(INSNAME)
- SET SYMIEN=$$ERROR^IBCNEUT8("B11","Insurance company "_INSNAME_" contains MEDICAID in the name. Electronic inquiries cannot be made to this insurance company.")
- GOTO VALIDX
- +9 ; Retrieve the Payer IEN associated with this ins co
- +10 SET PAYIEN=$PIECE($GET(^DIC(36,INSIEN,3)),U,10)
- +11 IF PAYIEN=""
- SET SYMIEN=$$ERROR^IBCNEUT8("B4","Insurance company "_INSNAME_" is not linked to a Payer.")
- GOTO VALIDX
- +12 ; Payer val'n
- DO VALPYR(INSNAME)
- VALIDX ;
- +1 QUIT
- +2 ;
- PAYER(PAYIEN) ;
- +1 ; Entry pt for Most Pop Payer (called by POP^IBCNEDE4)
- +2 ; IB*2*601/DM comments and adjust return to add PAYIEN
- +3 ; Additionally, called from INSERROR^IBCNEUT3() for MBI Inquiries
- +4 ; Returned value consists of the following "^"-delimited pcs:
- +5 ; [1] The IEN of the IIV SYMBOL File (#365.15) entry for
- +6 ; the first error condition encountered by the function.
- +7 ; This is only present if a valid Payer was not found.
- +8 ; [2] Payer IEN if a Payer was found, "" otherwise
- +9 ; [3] National ID if a Payer was found
- +10 NEW SYMIEN,PAYID
- +11 ; Set within tag VALPYR these variables are never
- NEW APPDATA,APPIEN
- +12 ; killed. Using tag VALID's method of NEWing variables
- +13 ; first will allow them to be killed appropriately.
- +14 ; This is an array that is set by ERROR^IBCNEUT8 but never
- NEW ARRAY
- +15 ; killed. When there is a most popular payer that is not
- +16 ; eligible for inquiries, ARRAY would continue to grow.
- +17 SET (SYMIEN,PAYID)=""
- +18 DO VALPYR("")
- +19 QUIT SYMIEN_U_PAYIEN_U_PAYID
- +20 ;
- VALPYR(INSNM) ;
- +1 ; Payer Val'n - note: PAYIEN (payer IEN) must be set
- +2 ; If INSNM="" val'n is for Most Pop Payer
- +3 NEW DEACT,PAYNM
- +4 ;
- +5 ; Init variable if not passed
- SET INSNM=$GET(INSNM)
- +6 ; Retrieve the National ID(Payer ID) for this Payer IEN
- +7 SET PAYID=$PIECE($GET(^IBE(365.12,PAYIEN,0)),U,2)
- +8 IF PAYID=""
- SET SYMIEN=$$ERROR^IBCNEUT8("B9","Payer IEN "_PAYIEN_" does not have a Payer.")
- QUIT
- +9 ; Retrieve payer name
- +10 SET PAYNM=$PIECE($GET(^IBE(365.12,PAYIEN,0)),U,1)
- +11 ; Retrieve the IEN of the eIV Application
- +12 ;IB*668/TAZ - Changed Payer Application from IIV to EIV
- +13 SET APPIEN=$$PYRAPP^IBCNEUT5("EIV",PAYIEN)
- +14 IF APPIEN=""
- SET SYMIEN=$$ERROR^IBCNEUT8("B9","The eIV Payer Application has not been created for this site.")
- QUIT
- +15 ; Verify the existence of the application for this Payer
- +16 IF '$DATA(^IBE(365.12,PAYIEN,1,APPIEN))
- SET SYMIEN=$$ERROR^IBCNEUT8("B7","Insurance company "_INSNM_" is linked to Payer "_PAYNM_" which is not set up to accept electronic insurance eligibility requests.")
- QUIT
- +17 ; Retrieve the eIV-specific application data for this Payer
- +18 SET APPDATA=$GET(^IBE(365.12,PAYIEN,1,APPIEN,0))
- +19 ;IB*668/DW - Update comment and error text to reflect change from 'national/local active' to 'nationally/locally enabled'
- +20 ; Check the Payer's national enabled status and local enabled status. If the payer is not both
- +21 ; enabled for both then return one or, if applicable, BOTH errors
- +22 ;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.")
- +23 ;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.")
- +24 IF '$PIECE(APPDATA,U,3)
- SET SYMIEN=$$ERROR^IBCNEUT8("B6","Insurance company "_INSNM_" is linked to Payer "_PAYNM_" which is not locally enabled for eIV.")
- +25 IF '$PIECE(APPDATA,U,2)
- SET SYMIEN=$$ERROR^IBCNEUT8("B5","Insurance company "_INSNM_" is linked to Payer "_PAYNM_" which is not nationally enabled for eIV.")
- +26 ;IB*668/TAZ - Call PYRDEACT to get Payer Deactivated from new file location.
- +27 ; Check if the Payer has been deactivated, if so report it
- +28 SET DEACT=$$PYRDEACT^IBCNINSU(PAYIEN)
- +29 IF +DEACT
- SET SYMIEN=$$ERROR^IBCNEUT8("B14","Insurance company "_INSNM_" is linked to Payer "_PAYNM_" which has been deactivated as of "_$$FMTE^XLFDT($PIECE(DEACT,U,2),"5Z")_".")
- +30 QUIT
- +31 ;
- MULTNAME(TEXT,LIST) ; Function to return an error message with a list of multiple names
- +1 ; Input parameters:
- +2 ; TEXT - Error text to display
- +3 ; LIST - List of items, can be either a list of ins co
- +4 ; names or National ID names
- +5 ; Output parameter: Function value - Formatted list of items in 1 string
- +6 NEW COLIST,I,NAME,TOOLONG
- +7 SET NAME=""
- SET COLIST=TEXT
- SET TOOLONG=0
- +8 FOR I=1:1
- SET NAME=$ORDER(LIST(NAME))
- if NAME=""
- QUIT
- Begin DoDot:1
- +9 ; Add this name to the list of found names
- +10 IF I=1
- SET COLIST=COLIST_": "_NAME
- +11 IF '$TEST
- SET COLIST=COLIST_", "_NAME
- +12 ; check if the list of items may cause a MAXSTRING error
- +13 IF $LENGTH(COLIST)<450
- QUIT
- +14 SET COLIST=COLIST_" (Too many items to display)"
- SET TOOLONG=1
- End DoDot:1
- if TOOLONG
- QUIT
- +15 ;
- +16 QUIT COLIST_"."
- +17 ;