- 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 Jan 18, 2025@03:12:48 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 #