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