| 1 | IBCNSOK1 ;ALB/AAS - Insurance consisitency stuff ; 2/22/93
|
|---|
| 2 | ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | DUPCO(DFN,IBCNS,IBCDFN,IBTALK) ; -- is this a duplicate company for this patient
|
|---|
| 6 | ; -- make this call after selecting a company
|
|---|
| 7 | ; -- input DFN = patient file pointer (required)
|
|---|
| 8 | ; IBCNS = new insurance company selected
|
|---|
| 9 | ; IBCDFN = if added to patient ins type mult is required as enter number in multiple
|
|---|
| 10 | ; IBTALK = (optional) if defined and true will write messages to current device if not queued
|
|---|
| 11 | ; -- output = $p1 - 0 if no other entry 1 if possible dup.
|
|---|
| 12 | ; $p2 - 1 if another active entry for same company
|
|---|
| 13 | ; $p3 - 1 if same co, same subscriber
|
|---|
| 14 | ; $p4 - 1 if same co, same dates
|
|---|
| 15 | ; $p5 - 1 if same co, same plan
|
|---|
| 16 | ; $p6 - 1 if spouse insurer but not listed
|
|---|
| 17 | ; $p7 - 1 if spouse insurer but no employer
|
|---|
| 18 | N IBI,IBJ,IBX,IBY,I,J,X,Y,Z,IBDUP,IBACT,IBCDFND
|
|---|
| 19 | S (I,IBDUP)=0
|
|---|
| 20 | I '$O(^DPT(DFN,.312,0)) G DUPCOQ ; no policies on file, don't bother
|
|---|
| 21 | ;
|
|---|
| 22 | ; -- use b x-ref
|
|---|
| 23 | F S I=$O(^DPT(DFN,.312,"B",IBCNS,I)) Q:'I S IBX=$G(^DPT(DFN,.312,I,0)) I $S('$G(IBCDFN):1,I=$G(IBCDFN):0,1:1) D
|
|---|
| 24 | .S IBDUP=1
|
|---|
| 25 | .S IBACT=$$CHK^IBCNS1(IBX,DT,2) I IBACT S $P(IBDUP,"^",2)=1 ; another active entry
|
|---|
| 26 | .I '$G(IBCDFN) Q ;quit if not stored in dpt
|
|---|
| 27 | .I 'IBACT Q
|
|---|
| 28 | .;
|
|---|
| 29 | .S IBCDFND=$G(^DPT(DFN,.312,+IBCDFN,0)) I IBCDFND=""!(IBCDFND=+IBCDFND) Q
|
|---|
| 30 | .I $P(IBX,"^",6)=$P(IBCDFND,"^",6) S $P(IBDUP,"^",3)=1 ; same whose ins.
|
|---|
| 31 | .I $P(IBX,"^",4)="",$P(IBCDFND,"^",4)="" S $P(IBDUP,"^",4)=1 ; no expiration date
|
|---|
| 32 | .I $P(IBX,"^",8)="",$P(IBCDFND,"^",8)="" S $P(IBDUP,"^",4)=1 ; no effective date
|
|---|
| 33 | .; need to figure out overlapping date logic. not simple
|
|---|
| 34 | .I $P(IBX,"^",18)=$P(IBCDFND,"^",18) S $P(IBDUP,"^",5)=1 ; same plan
|
|---|
| 35 | .I $P(IBCDFND,"^",6)="s" I $P(^DPT(DFN,0),"^",5)=6!($P(^DPT(DFN,0),"^",5)=7) S $P(IBDUP,"^",6)=1 ; marital status inconsistent
|
|---|
| 36 | .I $P(IBCDFND,"^",6)="s",$P($G(^DPT(DFN,.25)),"^")="" S $P(IBDUP,"^",7)=1
|
|---|
| 37 | I 'IBDUP G DUPCOQ
|
|---|
| 38 | I IBDUP,$G(IBTALK),'$D(ZTQUEUED) D
|
|---|
| 39 | .W !!,*7,"Warning: Insurance Company selected already on file for this patient."
|
|---|
| 40 | .I $P(IBDUP,"^",2) W !," The previous entry is active."
|
|---|
| 41 | .I $P(IBDUP,"^",3) W !," The WHOSE INSURANCE are the same."
|
|---|
| 42 | .I $P(IBDUP,"^",4) W !," The Effective and Expiration dates may cover overlapping dates."
|
|---|
| 43 | .I $P(IBDUP,"^",5) W !," The Group Plans are the same."
|
|---|
| 44 | .I $P(IBDUP,"^",6) W !," WHOSE INSURANCE is Spouse, patient marital Status Inconsistent."
|
|---|
| 45 | .I $P(IBDUP,"^",7) W !," WHOSE INSURANCE is Spouse but no Employer listed."
|
|---|
| 46 | .Q
|
|---|
| 47 | ;
|
|---|
| 48 | DUPCOQ Q IBDUP
|
|---|
| 49 | ;
|
|---|
| 50 | DUPPOL(IBCPOL,IBTALK) ; -- is this a duplicate policy for this company
|
|---|
| 51 | N I,J,X,Y,Z,IBDUP,IBCNS
|
|---|
| 52 | S (I,IBDUP)=0,J=$G(^IBA(355.3,IBCPOL,0)),IBCNS=+J
|
|---|
| 53 | F S I=$O(^IBA(355.3,"B",IBCNS,I)) Q:'I I I'=IBCPOL S X=$G(^IBA(355.3,I,0)) D
|
|---|
| 54 | .Q:'$P(X,"^",2) ;skip individual policies
|
|---|
| 55 | .I $P(J,"^",3)'="",$P(J,"^",3)=$P(X,"^",3) S $P(IBDUP,"^")=1
|
|---|
| 56 | .I $P(J,"^",4)'="",$P(J,"^",4)=$P(X,"^",4) S $P(IBDUP,"^",2)=1
|
|---|
| 57 | I IBDUP,$G(IBTALK),'$D(ZTQUEUED) D
|
|---|
| 58 | .I $P(IBDUP,"^",1) W !!,"Warning: There is another policy with the same Group Name."
|
|---|
| 59 | .I $P(IBDUP,"^",2) W !!,"Warning: There is another policy with the same Group Number."
|
|---|
| 60 | ;
|
|---|
| 61 | DUPPOLQ Q IBDUP
|
|---|
