| 1 | IBCEP1 ;ALB/TMP - EDI UTILITIES for provider ID ;13-DEC-99
|
---|
| 2 | ;;2.0;INTEGRATED BILLING;**137**;21-MAR-94
|
---|
| 3 | ;
|
---|
| 4 | CAREID(IBFUNC,IBSEQ,IBIFN) ; Help text for a claim to determine the
|
---|
| 5 | ; specific care unit needed for a given insurance co
|
---|
| 6 | ; IBFUNC = "PERF" if looking for performing provider
|
---|
| 7 | ; = "EMC" if looking for EMC provider #
|
---|
| 8 | ; IBSEQ = the number of the COB sequence for the insurance co
|
---|
| 9 | ; IBIFN = the ien of the bill in file 399
|
---|
| 10 | N Z,Z0,Z1,Z2
|
---|
| 11 | S Z0=$$INSSEQ(IBIFN,IBSEQ)
|
---|
| 12 | S Z1=$S(IBFUNC="PERF":"performing provider id",1:"EMC id")
|
---|
| 13 | S Z=$P($G(^DIC(36,+Z0,4)),U,$S(IBFUNC="PERF":9,1:8))
|
---|
| 14 | S Z2=$$PPTYP^IBCEP0(Z0)
|
---|
| 15 | I $O(^IBA(355.96,"AC",Z0,Z2,0)) D
|
---|
| 16 | . D EN^DDIOL("This insurance company needs a care unit "_$S(Z'="":"("_Z_") ",1:"")_"for their "_Z1)
|
---|
| 17 | E D
|
---|
| 18 | . D EN^DDIOL("This insurance company does not need a care unit for their "_Z1)
|
---|
| 19 | Q
|
---|
| 20 | ;
|
---|
| 21 | INSSEQ(IBIFN,IBSEQ) ; Returns the ien of the insurance co for the COB
|
---|
| 22 | ; sequence IBSEQ on bill ien IBIFN
|
---|
| 23 | ; Returns 0 if no insurance co found
|
---|
| 24 | Q +$$FINDINS^IBCEF1(IBIFN,IBSEQ)
|
---|
| 25 | ;
|
---|
| 26 | DUP(IBFLD,DA) ; Test if there is a duplicate record already on file (355.9)
|
---|
| 27 | ; Function returns 1 if dup found, 0 if no dup found
|
---|
| 28 | ; IBFLD = ien of the field being checked
|
---|
| 29 | ; DA = the ien of the record being checked
|
---|
| 30 | N DUP,Q,S1,S2,S3,S4,S5,S6,Z,Z0
|
---|
| 31 | S Q=$G(^IBA(355.9,+DA,0)),DUP=0
|
---|
| 32 | S S1=$S(IBFLD=.01:X,1:$P(Q,U))
|
---|
| 33 | S S2=$S(IBFLD=.02:X,1:$P(Q,U,15)),Z=$$EXPAND^IBTRE(355.9,.02,S2) S:Z="" Z="ALL INSURANCE CO" S:S2="" S2="*ALL*"
|
---|
| 34 | S S3=$S(IBFLD=.03:X,1:$P(Q,U,16)),Z0=$$EXPAND^IBTRE(355.9,.03,S3) S:Z0="" Z0="ALL CARE UNITS"
|
---|
| 35 | S S4=$S(IBFLD=.04:X,1:$P(Q,U,4))
|
---|
| 36 | S S5=$S(IBFLD=.05:X,1:$P(Q,U,5))
|
---|
| 37 | S S6=$S(IBFLD=.06:X,1:$P(Q,U,6))
|
---|
| 38 | I S1'="",S4'="",S5'="",S6'="",$O(^IBA(355.9,"AUNIQ",S1,S2,S3,S4,S5,S6,0)),$O(^(0))'=DA D
|
---|
| 39 | . N MSG
|
---|
| 40 | . S MSG(1)="Duplicate entry already on file:"
|
---|
| 41 | . S MSG(1,"F")="!!?3"
|
---|
| 42 | . S MSG(2)=$E($$EXPAND^IBTRE(355.9,.01,S1),1,25)_" "_$E(Z,1,29)_" "_$E(Z0,1,17)
|
---|
| 43 | . S MSG(2,"F")="!?5"
|
---|
| 44 | . S MSG(3)=$$EXPAND^IBTRE(355.9,.04,S4)_" "_$$EXPAND^IBTRE(355.9,.05,S5)_" "_$$EXPAND^IBTRE(355.9,.06,S6)
|
---|
| 45 | . S MSG(3,"F")="!?5"
|
---|
| 46 | . S MSG(4)=" ",MSG(4,"F")="!"
|
---|
| 47 | . D EN^DDIOL(.MSG)
|
---|
| 48 | . S DUP=1
|
---|
| 49 | Q DUP
|
---|
| 50 | ;
|
---|
| 51 | DUP1(IBFLD,DA) ; Test if there is a duplicate record already on file (355.91)
|
---|
| 52 | ; Function returns 1 if dup found, 0 if no dup found
|
---|
| 53 | ; IBFLD = ien of the field being checked
|
---|
| 54 | ; DA = the ien of the record being checked
|
---|
| 55 | N DUP,Q,S1,S2,S3,S4,S5,Z0
|
---|
| 56 | S Q=$G(^IBA(355.91,+DA,0)),DUP=0
|
---|
| 57 | S S1=$S(IBFLD=.01:X,1:$P(Q,U))
|
---|
| 58 | S S2=$S(IBFLD=.03:X,1:$P(Q,U,10)),Z0=$$EXPAND^IBTRE(355.91,.03,S2) S:Z0="" Z0="ALL CARE UNITS"
|
---|
| 59 | S S3=$S(IBFLD=.04:X,1:$P(Q,U,4))
|
---|
| 60 | S S4=$S(IBFLD=.05:X,1:$P(Q,U,5))
|
---|
| 61 | S S5=$S(IBFLD=.06:X,1:$P(Q,U,6))
|
---|
| 62 | I S1'="",S3'="",S4'="",S5'="",$O(^IBA(355.91,"AUNIQ",S1,S2,S3,S4,S5,0)),$O(^(0))'=DA D
|
---|
| 63 | . N MSG
|
---|
| 64 | . S DUP=1
|
---|
| 65 | . S MSG(1)="Duplicate entry already on file:",MSG(1,"F")="!!?3"
|
---|
| 66 | . S MSG(2)=$E($$EXPAND^IBTRE(355.91,.01,S1),1,25)_" "_$E(Z0,1,30)
|
---|
| 67 | . S MSG(2,"F")="!?5"
|
---|
| 68 | . S MSG(3)=$$EXPAND^IBTRE(355.91,.04,S3)_" "_$$EXPAND^IBTRE(355.91,.05,S4)_" "_$$EXPAND^IBTRE(355.91,.06,S5)
|
---|
| 69 | . S MSG(3,"F")="!?5",MSG(4)=" ",MSG(4,"F")="!"
|
---|
| 70 | . D EN^DDIOL(.MSG)
|
---|
| 71 | Q DUP
|
---|
| 72 | ;
|
---|