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 Oct 16, 2024@18:16:13 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 ;
