Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCNEUT4

IBCNEUT4.m

Go to the documentation of this file.
  1. 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
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ; Can't be called from the top
  1. Q
  1. ;
  1. ;
  1. ACTIVE(INSDA) ; Is this insurance company currently active? 1:yes or 0:no
  1. ; Insurance company name returned in the second piece.
  1. ; Input: INSDA - insurance company ien
  1. NEW ACTFLG,INSDATA
  1. S ACTFLG=0 ; default inactive
  1. I '$G(INSDA) G ACTIVEX ; bad data passed in
  1. S INSDATA=$G(^DIC(36,INSDA,0)) ; zero node of File 36
  1. I INSDATA="" G ACTIVEX ; bad record
  1. I $P(INSDATA,U,5) G ACTIVEX ; INACTIVE flag is true
  1. I $P($G(^DIC(36,INSDA,5)),U,1) G ACTIVEX ; SCHEDULED FOR DELETION flag is true
  1. S ACTFLG=1 ; Otherwise, its active
  1. ACTIVEX ;
  1. Q ACTFLG_U_$P($G(^DIC(36,+$G(INSDA),0)),U,1)
  1. ;
  1. ;
  1. EXCLUDE(NAME) ; This function determines if we should exclude the insurance
  1. ; company based on the name.
  1. ; This function returns 1 if we should exclude the insurance company.
  1. ; This function returns 0 if we should not exclude it (i.e. include it)
  1. ;
  1. ; Initialize flag; default to not exclude it
  1. NEW EXCL
  1. S EXCL=0
  1. ;
  1. ; Screen out bad data
  1. I $G(NAME)="" S EXCL=1 G EXCLUDX
  1. ;
  1. ; Screen out MEDICAID ins co
  1. I NAME["MEDICAID" S EXCL=1
  1. EXCLUDX ;
  1. Q EXCL
  1. ;
  1. ;
  1. 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
  1. ; buffer entry). If the FORCE variable is not passed then the eIV
  1. ; status will only be cleared if the existing status is an error status
  1. ;
  1. ; Parameters
  1. ; DA - required input parameter; buffer ien
  1. ; EDITED - optional output parameter; this will tell you if the
  1. ; buffer symbol was cleared
  1. ; FORCE - optional input parameter; if this is set to 1 then the
  1. ; eIV status field will be cleared regardless of the
  1. ; current status
  1. NEW DIE,DR,D,D0,DI,DIC,DISYS,DQ,X,%
  1. I '$G(DA) G CLEARX
  1. I '$D(FORCE) S FORCE=0
  1. I 'FORCE,$$SYMBOL^IBCNBLL(DA)'="!" G CLEARX
  1. S DIE=355.33,DR=".12///@"
  1. D ^DIE
  1. S EDITED=1
  1. CLEARX ;
  1. Q
  1. ;
  1. ;
  1. INFO(IBBUFDA) ; Return original and current buffer data
  1. ; This procedure will retrieve the following data from the buffer and
  1. ; from the transmission queue file. The buffer holds the current data
  1. ; and the TQ file holds the original buffer data.
  1. ; Input
  1. ; IBBUFDA - buffer internal entry number
  1. ; Output
  1. ; a pieced string as follows
  1. ; [1] Has this buffer entry been transmitted? 1/0
  1. ; [2] Current buffer source of information (external)
  1. ; [3] Current buffer source of information (internal)
  1. ; [4] Current buffer insurance company name
  1. ; [5] Current buffer group number
  1. ; [6] Current buffer group name
  1. ; [7] Current buffer subscriber ID
  1. ; [8] Original buffer insurance company name
  1. ; [9] Original buffer group number
  1. ; [10] Original buffer group name
  1. ; [11] Original buffer subscriber ID
  1. ;
  1. NEW IB0,IB20,IB90,DATA,RESPIEN,FOUND,TQIEN,TQDATA,TQDATA1,DISYS
  1. S DATA=""
  1. I '$G(IBBUFDA) G INFOX
  1. I '$D(^IBA(355.33,IBBUFDA)) G INFOX
  1. S IB0=$G(^IBA(355.33,IBBUFDA,0))
  1. S IB20=$G(^IBA(355.33,IBBUFDA,20))
  1. S IB90=$G(^IBA(355.33,IBBUFDA,90)) ; IB*2.0*497 (vd)
  1. S $P(DATA,U,1)=0 ; default to not been transmitted
  1. S $P(DATA,U,2)=$$EXTERNAL^DILFD(355.33,.03,"",$P(IB0,U,3)) ; source
  1. S $P(DATA,U,3)=$P(IB0,U,3) ; internal source
  1. S $P(DATA,U,4)=$P(IB20,U,1) ; insurance company name
  1. S $P(DATA,U,5)=$P(IB90,U,2) ; group number - IB*2.0*497 (vd)
  1. S $P(DATA,U,6)=$P(IB90,U,1) ; group name - IB*2.0*497 (vd)
  1. S $P(DATA,U,7)=$P(IB90,U,3) ; subscriber id - IB*2.0*497 (vd)
  1. ;
  1. ; Look at the response file and the transmission queue file. Since
  1. ; we're trying to get the original data look at the oldest data first.
  1. S RESPIEN=0,FOUND=0
  1. F S RESPIEN=$O(^IBCN(365,"AF",IBBUFDA,RESPIEN)) Q:'RESPIEN D Q:FOUND
  1. . S TQIEN=$P($G(^IBCN(365,RESPIEN,0)),U,5)
  1. . I 'TQIEN Q
  1. . S TQDATA=$G(^IBCN(365.1,TQIEN,0))
  1. . S TQDATA1=$G(^IBCN(365.1,TQIEN,1))
  1. . I TQDATA="" Q
  1. . S $P(DATA,U,8)=$P(TQDATA1,U,2) ; insurance company name
  1. . S $P(DATA,U,9)=$P(TQDATA1,U,3) ; group number
  1. . S $P(DATA,U,10)=$P(TQDATA1,U,4) ; group name
  1. . S $P(DATA,U,11)=$P(TQDATA1,U,5) ; subscriber id
  1. . S FOUND=1 ; Stop once we have some data
  1. . Q
  1. ;
  1. I FOUND S $P(DATA,U,1)=1
  1. INFOX ;
  1. Q DATA
  1. ;
  1. ;
  1. VALID(INSIEN,PAYIEN,PAYID,SYMIEN) ; Validate an Ins Co IEN
  1. ; Input parameter: INSIEN - Ins co IEN, passed by value
  1. ; Output parameters: PAYIEN, PAYID, SYMIEN, passed by reference
  1. N APPDATA,APPIEN,INSNAME
  1. ; Retrieve the Ins Co name
  1. S INSNAME=$P($G(^DIC(36,INSIEN,0)),U,1)
  1. I INSNAME="" S SYMIEN=$$ERROR^IBCNEUT8("B9","Insurance company IEN "_INSIEN_" doesn't have a name on file.") G VALIDX
  1. ; Screen out MEDICAID ins co
  1. 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
  1. ; Retrieve the Payer IEN associated with this ins co
  1. S PAYIEN=$P($G(^DIC(36,INSIEN,3)),U,10)
  1. I PAYIEN="" S SYMIEN=$$ERROR^IBCNEUT8("B4","Insurance company "_INSNAME_" is not linked to a Payer.") G VALIDX
  1. D VALPYR(INSNAME) ; Payer val'n
  1. VALIDX ;
  1. Q
  1. ;
  1. PAYER(PAYIEN) ;
  1. ; Entry pt for Most Pop Payer (called by POP^IBCNEDE4)
  1. ; IB*2*601/DM comments and adjust return to add PAYIEN
  1. ; Additionally, called from INSERROR^IBCNEUT3() for MBI Inquiries
  1. ; Returned value consists of the following "^"-delimited pcs:
  1. ; [1] The IEN of the IIV SYMBOL File (#365.15) entry for
  1. ; the first error condition encountered by the function.
  1. ; This is only present if a valid Payer was not found.
  1. ; [2] Payer IEN if a Payer was found, "" otherwise
  1. ; [3] National ID if a Payer was found
  1. N SYMIEN,PAYID
  1. N APPDATA,APPIEN ; Set within tag VALPYR these variables are never
  1. ; killed. Using tag VALID's method of NEWing variables
  1. ; first will allow them to be killed appropriately.
  1. N ARRAY ; This is an array that is set by ERROR^IBCNEUT8 but never
  1. ; killed. When there is a most popular payer that is not
  1. ; eligible for inquiries, ARRAY would continue to grow.
  1. S (SYMIEN,PAYID)=""
  1. D VALPYR("")
  1. Q SYMIEN_U_PAYIEN_U_PAYID
  1. ;
  1. VALPYR(INSNM) ;
  1. ; Payer Val'n - note: PAYIEN (payer IEN) must be set
  1. ; If INSNM="" val'n is for Most Pop Payer
  1. N DEACT,PAYNM
  1. ;
  1. S INSNM=$G(INSNM) ; Init variable if not passed
  1. ; Retrieve the National ID(Payer ID) for this Payer IEN
  1. S PAYID=$P($G(^IBE(365.12,PAYIEN,0)),U,2)
  1. I PAYID="" S SYMIEN=$$ERROR^IBCNEUT8("B9","Payer IEN "_PAYIEN_" does not have a Payer.") Q
  1. ; Retrieve payer name
  1. S PAYNM=$P($G(^IBE(365.12,PAYIEN,0)),U,1)
  1. ; Retrieve the IEN of the eIV Application
  1. ;IB*668/TAZ - Changed Payer Application from IIV to EIV
  1. S APPIEN=$$PYRAPP^IBCNEUT5("EIV",PAYIEN)
  1. I APPIEN="" S SYMIEN=$$ERROR^IBCNEUT8("B9","The eIV Payer Application has not been created for this site.") Q
  1. ; Verify the existence of the application for this Payer
  1. 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
  1. ; Retrieve the eIV-specific application data for this Payer
  1. S APPDATA=$G(^IBE(365.12,PAYIEN,1,APPIEN,0))
  1. ;IB*668/DW - Update comment and error text to reflect change from 'national/local active' to 'nationally/locally enabled'
  1. ; Check the Payer's national enabled status and local enabled status. If the payer is not both
  1. ; enabled for both then return one or, if applicable, BOTH errors
  1. ;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.")
  1. ;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.")
  1. 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.")
  1. 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.")
  1. ;IB*668/TAZ - Call PYRDEACT to get Payer Deactivated from new file location.
  1. ; Check if the Payer has been deactivated, if so report it
  1. S DEACT=$$PYRDEACT^IBCNINSU(PAYIEN)
  1. 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")_".")
  1. Q
  1. ;
  1. MULTNAME(TEXT,LIST) ; Function to return an error message with a list of multiple names
  1. ; Input parameters:
  1. ; TEXT - Error text to display
  1. ; LIST - List of items, can be either a list of ins co
  1. ; names or National ID names
  1. ; Output parameter: Function value - Formatted list of items in 1 string
  1. N COLIST,I,NAME,TOOLONG
  1. S NAME="",COLIST=TEXT,TOOLONG=0
  1. F I=1:1 S NAME=$O(LIST(NAME)) Q:NAME="" D Q:TOOLONG
  1. . ; Add this name to the list of found names
  1. . I I=1 S COLIST=COLIST_": "_NAME
  1. . E S COLIST=COLIST_", "_NAME
  1. . ; check if the list of items may cause a MAXSTRING error
  1. . I $L(COLIST)<450 Q
  1. . S COLIST=COLIST_" (Too many items to display)",TOOLONG=1
  1. ;
  1. Q COLIST_"."
  1. ;