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

IBCEP3.m

Go to the documentation of this file.
  1. IBCEP3 ;ALB/TMP - EDI UTILITIES for provider ID ;25-SEP-00
  1. ;;2.0;INTEGRATED BILLING;**137,207,232,280,349,592**;21-MAR-94;Build 58
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. CUNEED(IBIFN,IBSEQ,IBPTYP,IBRET,IBEMC) ; Determine if care unit needed for
  1. ; provider type and insurance company(s) on bill
  1. ; IBIFN = ien of bill (file 399)
  1. ; IBSEQ = specific COB sequence to check or null for check all
  1. ; IBPTYP = the ien of the provider id type in file 355.97 or if null,
  1. ; the default performing provider ID type for the ins co's.
  1. ; IBRET = flag to return insurance ien (0) or file 355.97 ien (1)
  1. ; IBEMC = no longer used
  1. ;
  1. ; Function returns care unit needed flag (0=not needed, 1=needed) ^
  1. ; AND if IBSEQ="": primary ins or 355.97 ien if care unit needed ^
  1. ; secondary ins or 355.97 ien if care unit needed ^
  1. ; tertiary ins or 355.97 ien if care unit needed
  1. ; (these would be '^' pieces 2,3,4)
  1. ; if IBSEQ : IBSEQ seq ins or 355.97 ien if care unit needed
  1. ; (this would be '^' piece 2)
  1. ;
  1. Q:$G(IBEMC) 0
  1. N Q,Z,Z0,Z4,IB,IBCTYP,IBFTYP,IBQ,IBRX,IBPT
  1. S (IBRX,IB)=0
  1. S IBFTYP=$$FT^IBCEF(IBIFN),IBCTYP=$$INPAT^IBCEF(IBIFN,1)
  1. ;JWS;IB*2.0*592; If Dental quit
  1. I IBFTYP=7 Q IB
  1. S IBFTYP=$S(IBFTYP=3:1,1:2) S:IBCTYP'=1 IBCTYP=2
  1. I IBCTYP=2 S IBRX=$$ISRX^IBCEF1(IBIFN) ; Outpatient pharmacy
  1. S IBPT=$G(IBPTYP)
  1. ;
  1. S (Z,IBQ)=0
  1. F D Q:IBQ
  1. . I $G(IBSEQ) S Z=IBSEQ,IBQ=1 ; Only once for specific COB sequence
  1. . I '$G(IBSEQ) S Z=Z+1,IBPTYP=IBPT I Z>3 S IBQ=1 Q ; Up to 3 times - all ins
  1. . S Z0=$$INSSEQ^IBCEP1(IBIFN,Z),Z4=$G(^DIC(36,+Z0,4))
  1. . I '$G(IBPTYP) S IBPTYP=+Z4
  1. . I 'Z0!'IBPTYP S:'Z0 IBQ=1 Q
  1. . S Q=+$$CAREUN(Z0,IBPTYP,IBFTYP,IBCTYP,IBRX)
  1. . I Q S $P(IB,U,$S($G(IBSEQ):Z+1,1:2))=$S($G(IBRET):Q,1:Z0)
  1. ;
  1. I $TR(IB,"^0") S $P(IB,U)=1
  1. Q IB
  1. ;
  1. CAREUN(IBINS,IBPTYP,IBFTYP,IBCTYP,IBRX) ; Find ien (file 355.96) for care
  1. ; unit for the combination of ins co, prov type, form type and
  1. ; care type
  1. ; IBINS = ien of ins co (file 36)
  1. ; IBPTYP = ien of provider id type (file 355.97)
  1. ; IBFTYP = form type (1=UB,2=1500)
  1. ; IBCTYP = care type (1=inpat,2=outpat)
  1. ; IBRX = 1 if outpat/Rx bill
  1. ;
  1. N IB
  1. S IB=""
  1. ;
  1. I $G(IBRX) D
  1. . N T
  1. . S T=$O(^IBA(355.96,"AD",IBINS,IBFTYP,3,IBPTYP,0))
  1. . I 'T S T=$O(^IBA(355.96,"AD",IBINS,0,3,IBPTYP,0))
  1. . I T S IB=T
  1. ;
  1. I 'IB D ; Find from most specific to least specific
  1. . I $O(^IBA(355.96,"AD",IBINS,IBFTYP,IBCTYP,IBPTYP,0)) S IB=+$O(^(0)) Q
  1. . I $O(^IBA(355.96,"AD",IBINS,IBFTYP,0,IBPTYP,0)) S IB=+$O(^(0)) Q
  1. . I $O(^IBA(355.96,"AD",IBINS,0,IBCTYP,IBPTYP,0)) S IB=+$O(^(0)) Q
  1. . I $O(^IBA(355.96,"AD",IBINS,0,0,IBPTYP,0)) S IB=+$O(^(0)) Q
  1. ;
  1. Q IB
  1. ;
  1. DISP(IBINS,IBTYPE) ; Return the name of the type of care unit needed
  1. ; IBINS = ien of ins co (file 36)
  1. ; IBTYPE = 2:PERFORMING PROVIDER ID
  1. I $G(IBTYPE)'=2 Q ""
  1. Q $P($G(^DIC(36,+IBINS,4)),U,9)
  1. ;
  1. DELID(IBIFN,IBSEQ,IBX) ; Delete all provider data specific to an ins co
  1. ; represented by the COB sequence IBSEQ for bill IBIFN
  1. ; IBX = 1 if called from care unit prompt - don't delete value
  1. N IBZ,IBDR,X,Y,Z0,Z1
  1. S IBZ=0
  1. Q:'$G(IBSEQ)!($G(IBSEQ)>3)
  1. F S IBZ=$O(^DGCR(399,IBIFN,"PRV",IBZ)) Q:'IBZ S Z0=$G(^(IBZ,0)),Z1=$G(^(1)) D
  1. . ; Delete provider id's
  1. . I $P(Z0,U,4+IBSEQ)'="" S IBDR(399.0222,IBZ_","_IBIFN_",",(4+IBSEQ/100))="@"
  1. . ; Delete provider id types
  1. . I $P(Z0,U,11+IBSEQ)'="" S IBDR(399.0222,IBZ_","_IBIFN_",",(11+IBSEQ/100))="@"
  1. . I $D(IBDR) D FILE^DIE(,"IBDR")
  1. Q
  1. ;
  1. SETID(IBIFN,IBSEQ) ; Default provider id for bill IBIFN and ins co for COB
  1. ; sequence IBSEQ
  1. N IBZ,X,Y,IBDR,IBT
  1. S IBZ=0
  1. Q ; No longer used as of patch 232
  1. ;Q:'$G(IBSEQ)!($G(IBSEQ)>3)
  1. ;F S IBZ=$O(^DGCR(399,IBIFN,"PRV",IBZ)) Q:'IBZ S Z0=$G(^(IBZ,0)),Z1=$G(^(1)) D
  1. ;. ; Update provider id's if no care unit is needed
  1. ;. I $P(Z0,U,2)'="" D
  1. ;.. S Z=$$GETID^IBCEP2(IBIFN,2,$P(Z0,U,2),IBSEQ,.IBT)
  1. ;.. I Z'="",IBT S IBDR(399.0222,IBZ_","_IBIFN_",",(4+IBSEQ/100))=Z,IBDR(399.0222,IBZ_","_IBIFN_",",(11+IBSEQ/100))=+IBT
  1. ;. I $D(IBDR) D FILE^DIE(,"IBDR")
  1. Q
  1. ;
  1. ALLID(IBIFN,IBFLD,IBFUNC) ; If form type or care type (I/O/RX) changes,
  1. ; determine new provider id values if possible and update them
  1. ; this includes primary, secondary, tertiary id's
  1. ; IBIFN = ien of claim (file 399)
  1. ; IBFLD = ien of the field being changed when this call is made
  1. ; (.19 = form type .25 = care type)
  1. ; IBFUNC = 1 to add, 2 to delete
  1. N Z,Z0,IBC,IBDR,IBT
  1. S Z=0
  1. F S Z=$O(^DGCR(399,IBIFN,"PRV",Z)) Q:'Z S Z0=$G(^(Z,0)) D
  1. . F IBC=5:1:7 I $S(IBFUNC=2:$P(Z0,U,IBC)'="",1:1) S IBDR(399.0222,IBC_","_IBIFN_",",(IBC/100))=$S(IBFUNC=2:"@",1:$$GETID^IBCEP2(IBIFN,2,$P(Z0,U,2),IBC-4,.IBT))
  1. I $D(IBDR) D FILE^DIE(,"IBDR")
  1. Q
  1. ;
  1. CUMNT ; Add/edit care unit
  1. N D,DIE,DIC,DIK,DIR,DA,X,Y,IB,IBINS,IBF,IBCT,IBOK,IBPTYP,IBOLD,IBY,IBINS1,IBPTYP1,DUOUT,DTOUT
  1. INS F D Q:Y'>0
  1. . S DIC="^DIC(36,",DIC(0)="AEMQ" D ^DIC K DIC
  1. . I $D(DUOUT)!$D(DTOUT) S Y=-1 Q
  1. . I Y'>0 S DIR(0)="EA",DIR("A")="Insurance Co is required - press enter to continue: " D ^DIR K DIR Q
  1. . S IBINS=+Y,IBF="A",IBINS1=$P(Y,U,2)
  1. I $O(^IBA(355.96,"D",IBINS,""))'="" D
  1. . W ! S DIR("A")="(A)dd or (E)dit entries?: ",DIR("B")="Add",DIR(0)="SA^A:Add;E:Edit" D ^DIR W ! K DIR
  1. . S IBF=Y
  1. Q:$G(IBF)=""!("AE"'[$G(IBF))
  1. ;
  1. I IBINS>0 D
  1. . I IBF="A" D NEW^IBCEP4A(1)
  1. . I IBF="E" D CHANGE^IBCEP4A(1)
  1. ;
  1. Q
  1. ;
  1. DUP(IBDA,IBOLD,IBFUNC) ; Check if the combination of ins co, prov type, care
  1. ; type and form already exists in file 355.96
  1. ; IBDA = ien of entry in file 355.96
  1. ; IBOLD = the 0-node before changes were made - used to reset the fields
  1. N DUP,IB0,DR,X,Y,DIK,DIE,DA
  1. S IB0=$G(^IBA(355.96,IBDA,0)),DUP=0
  1. ;
  1. I $O(^IBA(355.96,"AUNIQ",+$P(IB0,U,3),+IB0,+$P(IB0,U,4),+$P(IB0,U,5),+$P(IB0,U,6),0))'=IBDA!($O(^IBA(355.96,"AUNIQ",+$P(IB0,U,3),+IB0,+$P(IB0,U,4),+$P(IB0,U,5),+$P(IB0,U,6),""),-1)'=IBDA) D
  1. . S DUP=1
  1. . I IBFUNC="E" D
  1. .. S DR=";.01///"_$P(IBOLD,U)_";.03///"_$S($P(IBOLD,U,3)'="":"/"_$P(IBOLD,U,3),1:"@")_";.04///"_$S($P(IBOLD,U,4)'="":"/"_$P(IBOLD,U,4),1:"@")
  1. .. S DR=DR_";05///"_$S($P(IBOLD,U,5)'="":"/"_$P(IBOLD,U,5),1:"@")_";.06///"_$S($P(IBOLD,U,6)'="":"/"_$P(IBOLD,U,6),1:"@")
  1. .. S DA=IBDA,DIE="^IBA(355.96," D ^DIE
  1. . I IBFUNC="A" D
  1. .. S DA=IBDA,DIK="^IBA(355.96," D ^DIK
  1. Q DUP
  1. ;
  1. PROFID(IBIFN,IBSEQ,IBID) ; Return id and type of rendering provider id
  1. ; used for insurance co at COB seq IBSEQ for bill ien IBIFN
  1. ; RETURN VALUES:
  1. ; piece 1:
  1. ; 1 = FEDERAL TAX ID
  1. ; 2 = INSURANCE CO SPECIFIC ID
  1. ; 3 = NETWORK ID
  1. ; "" = not a CMS-1500 bill or no id found
  1. ; piece 2:
  1. ; the id #
  1. N IBTYP,IBXDATA,IBZ
  1. S:'$G(IBSEQ) IBSEQ=+$$COBN^IBCEF(IBXIEN)
  1. S IBTYP=""_U_$G(IBID)
  1. ;JWS;IB*2.0*592
  1. I $$FT^IBCEF(IBIFN)'=2,$$FT^IBCEF(IBIFN)'=7 G PROFIDQ
  1. I '$D(IBID) D F^IBCEF("N-ALL ATT/RENDERING PROV ID","IBZ",,IBIFN) S IBID=$$NOPUNCT^IBCEF($P(IBZ,U,IBSEQ+1))
  1. G:IBID="" PROFIDQ
  1. S IBTYP=$S($$NOPUNCT^IBCEF(IBID)=$$NOPUNCT^IBCEF($P($G(^IBE(350.9,1,1)),U,5)):1,$$NETWRK(IBIFN,IBID,IBSEQ):3,1:2)
  1. S IBTYP=IBTYP_U_IBID
  1. ;
  1. PROFIDQ Q IBTYP
  1. ;
  1. NETWRK(IBIFN,IBID,IBSEQ) ; Determine if ID number IBID is the same as the
  1. ; network id for the insurance co
  1. ; IBIFN = bill ien (file 399)
  1. ; IBSEQ = COB seq # of bill
  1. ; Returns 1 if network ID match is found for bill IBIFN, COB seq IBSEQ
  1. N IBINS,IBNET
  1. S IBNET=0
  1. Q IBNET
  1. ; This section needs work *********
  1. I '$G(IBSEQ) S IBSEQ=+$$COBN^IBCEF(IBXIEN)
  1. S IBINS=+$G(^DGCR(399,IBIFN,"I"_IBSEQ))
  1. I $P($G(^IBE(355.97,+$$PPTYP^IBCEP0(IBINS),1)),U,6) D
  1. . ; performing provider id type is a network id type
  1. . I $$NOPUNCT^IBCEF($G(IBID))=$$NOPUNCT^IBCEF($$GETID^IBCEP2(IBIFN,3,$$PERFPRV^IBCEP2A(IBIFN),IBSEQ)) S IBNET=1
  1. Q IBNET
  1. ;
  1. ;
  1. ; Parameter definitions for UNIQ1 and UNIQ2 in IBCEP2
  1. ; IBIFN = ien of bill (file 399)
  1. ; IBINS = ien of insurance co (file 36) or *ALL* for all insurance
  1. ; IBPTYP = the ien of the provider id type in file 355.97
  1. ; IBUNIT = the value of the specific care unit to use for a match
  1. ; or *N/A* if none needed
  1. ; IBCU = the ien of the entry being matched in start file
  1. ; IBT = the second and third pieces are set to the entry ien^file #